AW: Tabellen per Makro zusammenführen
07.11.2017 10:31:32
Michael
Hallo!
zB so:
Sub a()
Dim WbZ As Workbook: Set WbZ = ThisWorkbook
Dim WbQ As Workbook
Dim WsZ As Worksheet: Set WsZ = WbZ.Worksheets("Tabelle1")
Dim WsQ As Worksheet, Pfad$, Datei$, bHeader As Boolean
Application.ScreenUpdating = False
Pfad = "D:\DeinStartOrdner\" ' anpassen!
Pfad = IIf(Right(Pfad, 1) = "\", Pfad, Pfad & "\")
bHeader = True
Datei = Dir(Pfad & "*.xls*", vbDirectory)
Do Until Datei = ""
If Datei WbZ.Name Then
Set WbQ = Workbooks.Open(Pfad & Datei)
Set WsQ = WbQ.Worksheets(1)
WsQ.Rows("1:5").Delete
With WsQ.UsedRange
If bHeader Then .Resize(1, .Columns.Count).Copy _
WsZ.Cells(WsZ.Rows.Count, "A").End(xlUp)
.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Copy _
WsZ.Cells(WsZ.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
WbQ.Close True
bHeader = False
End If
Datei = Dir
Loop
Set WbZ = Nothing: Set WbQ = Nothing: Set WsZ = Nothing: Set WsQ = Nothing
End Sub
Dieser Code muss in ein allgemeines Modul in der Mappe, in der die Daten gesammelt werden. Dazu eine neue Mappe öffnen, mit [Alt] + [F11] den VBA-Editor öffnen, dann Einfügen, Modul, dort einfügen. Im Code musst Du den Startpfad (mit den auszulesenden Dateien) anpassen/angeben (ist im Code gekennzeichnet).
Der Code öffnet die auszlesenden Dateien, und übernimmt die Daten aus dem ersten Blatt, da bisher nicht klar war, ob es ggf. mehrere Blätter in den Quelldateien gibt. Geschrieben werden die Daten ebenfalls in das erste Blatt der Zieldatei.
Passt?
LG
Michael