Hallo,
wer Ergebnisse will, der muss auch liefern ;-).
Ich gehe mal davon aus, dass alle Tabelle gleich aufgebaut sind und sich nur diese 6 Tabelle in deiner Arbeitsmappe befinden.
Kopiere den folgenden Code in ein
Standard-Modul deiner Arbeitsmappe.
In der Tabelle, in der die Daten hineinkopiert werden, muss eine Überschriftenzeile vorhanden sein. Der Code darf nur aus der Tabelle gestartet werden, in der die Daten hineinkopiert werden sollen:
Sub uebersicht_erstellen()
Dim i As Long
Dim lngLetzteZ As Long
Dim lngLetzteQ As Long
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
With ActiveSheet
'eventuell vorhandene Daten im Zielarbeitsblatt ab Zeile 2 löschen
lngLetzteZ = .Cells(Rows.Count, 1).End(xlUp).Row
If lngLetzteZ > 2 Then .Range("A2:I" & lngLetzteZ).ClearContents
End With
'Alle Tabellenblätter durchlaufen
For i = 1 To ThisWorkbook.Worksheets.Count
'Daten nur dann kopieren, wenn nicht das aktive Arbeitsblatt angesprochen wird
If ThisWorkbook.Worksheets(i).Name <> ActiveSheet.Name Then
lngLetzteZ = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
With Worksheets(i)
'letzte Zeile in der Quell-Tabelle lesen
lngLetzteQ = .Cells(Rows.Count, 1).End(xlUp).Row
'Bereich aus Blatt ab Zeile 2 kopieren
.Range("A2:I" & lngLetzteQ).Copy Destination:=ActiveSheet.Range("A" & lngLetzteZ)
End With
End If
Next i
'Daten nach Startdatum sortieren
lngLetzteZ = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
With ActiveWorkbook.ActiveSheet
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("A2:A" & lngLetzteZ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:I" & lngLetzteZ)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True
End Sub
Die kopierten Daten werden nach dem Start-Datum sortiert.
Die Aktualisierung muss man aber "per Hand" starten. Es wäre auch möglich, die Aktualisierung z.B. beim Schließen oder Öffnen der Datei automatisch durchführen zu lassen.
Gruß
M.O.
