Office: (Office 2016) Makro VBA: Kopieren aus Quelldatei nach Zieldatei über mehrere Tabellen

Hallo, leider kann ich maximal Makros aufzeichnen. Damit komme ich bei meinem jetzigen Problem allerdings nicht weiter. Problem: Monatlich soll ein Auszug von Daten aus einer Quelldatei die ich zugeschickt bekomme in eine eigene Zieldatei übernommen werden. Quell- und Zieldatei bestehen aus mehreren Tabellenblättern mit festen Namen.
Der VBA-Code soll aus der Quelldatei, aus der Tabelle KundeA einen Bereich auswählen, kopieren und diesen ausgewählten Bereich transponiert in die Zieldatei KundeA einkopieren. Danach soll er zum nächsten Tabellenblatt KundeB gehen und hier den gleichen Arbeitsschritt durchführen. Das ganze geht über mehrere Tabellenblätter.
Aufgezeichnet sieht das Makro wie folgt aus:
Sub Makro2()
'
' Makro2 Makro
'

'
Workbooks.Open Filename:= _
"G:\Mitarbeiter VRM\Mueller_Noss\Access\Hilfe\Zieldatei.xlsx"
Windows("Quelldatei.xlsx").Activate
Range("B3:I5").Select
Selection.Copy
Windows("Zieldatei.xlsx").Activate
Sheets("KundeC").Select
Range("B3:D10").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Windows("Quelldatei.xlsx").Activate
Sheets("KundeB").Select
Range("B3:I5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zieldatei.xlsx").Activate
Sheets("KundeB").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Windows("Quelldatei.xlsx").Activate
Sheets("KundeA").Select
Range("B3:I5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zieldatei.xlsx").Activate
Sheets("KundeA").Select
Range("B3:D10").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Windows("Quelldatei.xlsx").Activate
Application.CutCopyMode = False
Application.Goto Reference:="Makro2"
Application.Goto Reference:="Makro2"
End Sub

Ich möchte allerdings gerne, dass die VBA automatisch von der einen Tabelle zur nächsten Tabelle springt, ohne das jeder Tabellennamen in der VBA angeben werden muss. Kann mir jemand weiterhelfen?

 

Hi,

ich hoffe ich habe deine Konstellation richtig interpretiert: die Arbeitsmappe "Quelldatei.xlsx" ist bereits geöffnet und der Code soll sich einer dritten Arbeitsmappe befinden, da du hier 2 xlsx-Dateien hochgeladen hast?

Code:

Sub Uebertragen()
    Dim wkbZ As Workbook
    Dim wkbQ As Workbook
    Dim wksKundeZ As Worksheet
    Dim wksKundeQ As Worksheet
    Set wkbZ = Workbooks.Open("G:\Mitarbeiter VRM\Mueller_Noss\Access\Hilfe\Zieldatei.xlsx")
    Set wkbQ = Workbooks("Quelldatei.xlsx")
    Application.ScreenUpdating = False
    With wkbZ
        For Each wksKundeZ In .Worksheets
            On Error Resume Next
            Set wksKundeQ = wkbQ.Worksheets(wksKundeZ.Name)
            If Err.Number <> 9 Then
                wksKundeQ.Range("B3:I5").Copy
                wksKundeZ.Range("B3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            End If
            On Error GoTo 0
        Next wksKundeZ
    End With
    Application.ScreenUpdating = True
End Sub

Bis später,
Karin

 

Hallo, vielen Dank für Deine Mühe. Sorry das ich erst jetzt antworte. Ich hatte früher keine Möglichkeit. Die Arbeitsmappe Quelldatei.xlsx ist bereits geöffnet und ich dachte der Code müsse dann in diese Datei. Der Code in der Quelldatei soll die Datei Zieldatei öffnen und dann einen Bereich im ersten Tabellenblatt der Quelldatei markieren, kopieren und dann in der Zieldatei das passende Tabellenblatt auswählen und dann den kopierten Bereich transponiert einfügen.

Wahlweise könnte ich auch beide Dateien öffnen und die Programmierung müßte nur noch Tabellenblatt auswählen, Bereich markieren, kopieren zur Datei Zieldatei wechseln hier transponiert einfügen. Dann wieder zurück zur Quelldatei, nächstes Tabellenblatt usw. usw. VG

Eine dritte Arbeitsmappe wird nic

 

Hi,

lade bitte das nächstemal die Mappe, in die der Code soll, als XLSM-Datei hoch, selbst wenn noch kein Code drin steht - nur dann ist es nämlich eindeutig, was genau du willst...

Ändere diese Codezeile:

Code:

    Set wkbQ = [B][COLOR=#ff0000]ThisWorkbook[/COLOR][/B]

Bis später,
Karin