Hallo smilz,
leider kann ich erst jetzt antworten, aber einerseits hat man nicht immer Zeit und andererseits war das für mich ne echte Herausforderung, da ich nicht der VBA-Experte bin.
Hier nun mein Vorschlag:
Sub aufgaben()
Dim wsNew As Worksheet
Dim wks As Worksheet
Dim i As Integer
Dim x As Integer
Dim zeilenAufgabenliste As Integer
Dim zeilenTabellex As Integer
'Zeilen in Aufgabenliste ermitteln
zeilenAufgabenliste = Worksheets(„Aufgabenliste“).Range(„A65536“).End(xlUp).Row
'Fehlerbehandlung wenn vorhandener Name für Blatt schon existiert
On Error GoTo fehler
'Schleife zum Anlegen von Blättern
For i = 2 To zeilenAufgabenliste
'Neues Blatt mit Namen aus Tabelle Aufgabenliste erstellen
Set wsNew = Worksheets.Add
With wsNew
'Namen änern und Formatieren
.Name = Format(Worksheets(„Aufgabenliste“).Cells(i, 1).Value, „yyyy-mm-dd“)
'neues Blatt ans Ende stelen
.Move after:=Sheets(Sheets.Count)
'nach Fehlerbehandlung hier weiter
Zeileueberspringen:
End With
Set wsNew = Nothing
'nächste Zeile in Blatt Aufgabenliste selektieren und Namen aufnehmen
Next i
'Schleife setzen um Daten mit gleicher Bezeichnung im Blatt Aufgabenliste in entsprechendes Blatt übertragen
For i = 2 To zeilenAufgabenliste
'richtiges Blatt suchen und Date übertragen
For x = 2 To Sheets.Count
If Sheets(x).Name = Format(Worksheets(„Aufgabenliste“).Cells(i, 1), „yyyy-mm-dd“) Then
Sheets(x).Select
'Anzahl Zeilen auf aktuellem Blatt ermitteln
zeilenTabellex = Worksheets(x).Cells(Rows.Count, 1).End(xlUp).Row
'Date einfügen auf zugehörigem Blatt
Worksheets(„Aufgabenliste“).Rows(i).Copy Destination:=Worksheets(x).Rows(zeilenTabellex + 1)
End If
Next x
Next i
'Sprungmarke zum Umgehen der Fehlerbehandlung
GoTo Ende
'Routine um neues Blatt zu löschen(da Name bereits vorhanden)
fehler:
'Namen vergleichen
If Format(wsNew.Name, „yyyy-mm-dd“) Worksheets(„Aufgabenliste“).Cells(i, 1).Value Then
'Bildschirmdarstellung ausschalten um Löschbestätigung auszublenden
Application.DisplayAlerts = False
'neues Blatt löschen
ActiveSheet.Delete
'Bildschirmdarstellung einschalten
Application.DisplayAlerts = True
End If
Resume Zeileueberspringen
'Sprungmarke um nicht in die Fehlerbehandlung zu laufen
Ende:
End Sub
Gruß Hugo