Ich habe doch eine Variante gefunden die ich anpassen konnte.
Sub Zusammenfassen()
Application.Volatile
Dim intI%, lngZ&, lngZA&, lngGesamt&
'Falls Blatt "Zusammenfassung" existiert, löschen:
On Error GoTo weiter
Application.DisplayAlerts = False
Sheets("Zusammenfassung").Delete
Application.DisplayAlerts = True
weiter:
'Neues Blatt erstellen:
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "Zusammenfassung"
[a2].Select
'Spaltenüberschriften aus zweitem Blatt eintragen:
Sheets(2).[a1:i1].Copy Destination:=Sheets(1).[a1]
'Überprüfen, ob es insgasamt über 65535 Datensätze sind:
For intI = 2 To Sheets.Count
With Sheets(intI)
lngZA = .Cells(Rows.Count, 1).End(xlUp).Row
lngGesamt = lngGesamt + lngZA - 1
If lngGesamt > 65535 Then
MsgBox "Zuviele Datensätze!", vbOKOnly + vbExclamation, "Fehler!"
Exit Sub
End If
End With
Next
'Einzelne Blätter auf Blatt "Zusammenfassung" zusammenfassen:
lngZ = 2
'von Blatt bis Blatt das zusammengefasst werden soll:
For intI = 2 To 10
With Sheets(intI)
lngZA = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(2, 1), .Cells(lngZA, 9)).Copy Destination:=Sheets(1).Cells(lngZ, 1)
lngZ = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
End With
Next
lngZ = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
End Sub
|