☰

Excel 使用 VBA 在文件之间转置

tag-icon • tag-icon microsoft-excel vba microsoft-excel-2016
Excel 使用 VBA 在文件之间转置

我需要在文件之间转置，但遇到了麻烦？当我仅在一个文件内转置时，我的代码可以工作。但是当我尝试转置到另一个文件时，却不行。我的语法显然有问题。

我有 80 份客户调查，希望将其转换为一份。

我的可行代码是：

Sub Trans2()
    Range("C14:C21").Select
    Selection.Copy
    Range("G6").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                           False, Transpose:=True
End Sub

但是，当我尝试从一个工作簿运行它并转置到另一个工作簿时，它失败了。

我的“损坏”代码是：

Sub TransposeInfo()
    '
    ' Transpose info between files
    '
    Dim mySource As String
    Dim myDest As String
    Dim wbkWorkbook1 As Workbook
    Dim wbkWorkbook2 As Workbook

    'Define path and filename
    mySource = "C:\2018\CustSvy001.xls*"
    myDest = "C:\2018\CustResults.xlsx"

    'Open files
    Set wbkWorkbook1 = Workbooks.Open(mySource)
    Set wbkWorkbook2 = Workbooks.Open(myDest)

    'Select items to transpose
    wbkWorkbook1.Worksheets("Q8").Range("B8:B11").Select
    Selection.Copy
    wbkWorkbook2.Worksheets("New").Range("G6").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                           False, Transpose:=True

    'Close the two workbooks
    wbkWorkbook1.Close (True)
    wbkWorkbook2.Close (True)
End Sub

有什么建议吗？我对 VBA 还不太熟悉，所以越简单越好。

答案1

如果您收到此错误：

错误信息

这是因为*文件名中的 - 将其替换为文件名中的确切字母

。

尝试这个：

Public Sub TransposeInfoBetweenFiles()
    Dim mySource As String
    Dim myDest As String
    Dim wbkWorkbook1 As Workbook
    Dim wbkWorkbook2 As Workbook

    'Define path and filename
    mySource = "C:\2018\CustSvy001.xlsx" '<- Replaced "*" with "x" or "m"
    myDest = "C:\2018\CustResults.xlsx"  '<- This is Ok (exact path and file name)

    Application.ScreenUpdating = False

    'Open files
    Set wbkWorkbook1 = Workbooks.Open(mySource)
    Set wbkWorkbook2 = Workbooks.Open(myDest)

    'Select items to transpose
    wbkWorkbook1.Worksheets("Q8").Range("B8:B11").Copy
    wbkWorkbook2.Worksheets("New").Range("G6").PasteSpecial Paste:=xlPasteAll, _
                                               SkipBlanks:=False, Transpose:=True
    'Close the two workbooks
    wbkWorkbook1.Close True
    wbkWorkbook2.Close True

    Application.ScreenUpdating = True
End Sub

相关内容