Excel: Transponieren zwischen Dateien mit VBA

Excel: Transponieren zwischen Dateien mit VBA

Ich muss zwischen Dateien transponieren, aber stecke fest? Wenn ich nur innerhalb einer Datei transponiere, funktioniert mein Code. Aber als ich versuchte, in eine andere Datei zu transponieren, funktionierte er nicht. Meine Syntax ist offensichtlich fehlerhaft.

Ich habe 80 Kundenumfragen, die ich in nur eine zusammenfassen möchte.

Mein Code, der funktioniert, ist:

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

Aber wenn ich versuche, es dann von einer Arbeitsmappe aus auszuführen und in eine andere zu übertragen, schlägt es fehl.

Mein "kaputter" Code ist:

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 

Irgendwelche Vorschläge? Ich bin bei VBA ziemlich unerfahren, also bitte, je weniger kompliziert, desto besser.

Antwort1

Wenn dieser Fehler auftritt:

Fehlermeldung

es liegt an dem *im Dateinamen - ersetzen Sie das durch den genauen Buchstaben in Ihrem Dateinamen

.

Versuche dies:


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

verwandte Informationen