Hallo Officer,
hier der Code:
Private Sub Workbook_Open()
Dim wksTab As Worksheet
Dim blnVorhanden As Boolean
Dim lngZeile As Long
Dim lngErste As Long
lngZeile = 2
' prüfen ob Tabellenblatt aktuelles Datum schon vorhanden
For Each wksTab In Worksheets
If wksTab.Name = Date Then
blnVorhanden = True
Exit For
End If
Next wksTab
' Tabellenblatt aktuelles Datum noch nicht vorhanden
If blnVorhanden = False Then
' neues Tabellenblatt erstellen
With Worksheets.Add
' Name aktuelles Datum
.Name = Date
' ans Ende stellen
.Move after:=Worksheets(Worksheets.Count)
' Überschrift der Spalten A:D kopieren
Worksheets("Tabelle1").Range("A1:D1").Copy .Range("A1")
' Schleife über alle Zeilen des Ausgangstabellenblattes
Do
' in Spalte C steht das aktuelle Datum
If Worksheets("Tabelle1").Cells(lngZeile, 3) = Date Then
' erste freie Zeile im Tabellenblatt des aktuellen Datums ermitteln
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
' Bereich A:D der laufenden Zeile ins Tabellenblatt aktuelles Datum kopieren
Worksheets("Tabelle1").Range("A" & lngZeile & "
" & lngZeile).Copy .Cells(lngErste, 1)
End If
lngZeile = lngZeile + 1
Loop While Worksheets("Tabelle1").Cells(lngZeile, 1) <> ""
End With
End If
End Sub
VG
Mexico67