Danke Sabina, ich habe mich von deinem Code inspirieren gelassen.
Mein aktueller Stand ist folgender. Leider bekomme ich bei dem Versuch den zu kopierenden Range mit Index anzusprechen die Fehlermeldung:
"Falsche Anzahl an Argumenten oder ungültige Zuweisung zu einer Eigenschaft".
Ich hab schon viel rumexperimentiert und gegoogelt, aber ich komme nicht drauf, wie ich diese Stelle umsetzen könnte.
Sub Tabellen_zusammen_fuehren()
Dim oTargetSheet As Object
Dim s As Long
Dim z As Long
Dim j As Long
Dim wks As Worksheet
Dim Data As Variant
Dim lngI As Long
Dim aletzte As Long
Dim zletzte As Long
Application.ScreenUpdating = False
Set oTargetSheet = ActiveWorkbook.Sheets("Tabelle1")
' Array mit Spaltennamen befüllen
letztespalte = oTargetSheet.Cells(1, 256).End(xlToLeft).Column
oTargetSheet.Activate
Data = Range(Cells(1, 1), Cells(1, letztespalte))
For Each wks In ActiveWorkbook.Worksheets
If Not wks.Name = oTargetSheet.Name Then
aletzte = wks.Cells(Rows.Count, 1).End(xlUp).Row + 1
With oTargetSheet
zletzte = .Cells(Rows.Count, 1).End(xlUp).Row + 1 ': If zletzte = 2 Then zletzte = 1
For lngI = LBound(Data) To UBound(Data)
Spalte = Data(1, lngI)
wks.Range(wks.Index(2, Spalte), wks.Index(aletzte, Spalte)).Copy Destination:=.Index(zletzte, Spalte)
Next lngI
' If zletzte > 1 Then .Rows(zletzte).Delete shift:=xlShiftUp
End With
End If
Next
Application.ScreenUpdating = True
'Variablen aufräumen
Set oTargetSheet = Nothing
Set oSourceBook = Nothing
End Sub
|