Hi,
ich habe mir mal vor längerer Zeit ein Makro geschrieben, welches aus einem Tabellenblatt mit Autofilter alle Einträge pro Filter in ein neues Tabellenblatt kopiert. Vielleicht würde dir das helfen, d.h. du bräuchtest in deiner Aufgabenliste eine Spalte mit Datum und dannwürde das Makro pro Datum alle EInträge in ein neues Blatt kopieren.
Bei Interesse sende mir bitte deine E-Mail-Adresse.
Gruß
Mario
Hallo,
das geht sicher mit VBA. Aber mit dem wenigen, was Sie hier beschrieben haben, kann ich noch nicht viel anfangen. Da müsste ich schon mal eine Beispieldatei haben, und da würde mir bestimmt was einfallen. Stehen denn die Aufgaben in der gleichen Exceldatei?
Der name der Blätter ist das Datum.
Ich würde wie folgt Vorgehen:
Dim lngL as Long
Dim lngLL as Long
Dim i as Integer
dim strTxt as String
i=0
For lngL =1 to 64536
if i=100 then exit sub '100 leere Zellen nacheinander
'Angenommen die Datums sind in Spalte D
'Cells(Reihe, Spalte)
if tabelle1.cells(lngL,4)„“ Then
i=0
txt = tabelle1.cells(lngL,4)
Workbook(txt).Select
for lngLL = 1 to 63536
'Leere zelle suchen
'Es wird immer in die Spalte C geschrieben!
if cells(lngLL,3)=„“ then exit for
next lngLL
cells(lngLL,3)=txt
else
i=i+1
end if
next lngL
Füge ins erste Tabellenblatt deine Daten ein wie es in den Hinweisen in der Mappe beschrieben wird.
Lösche dann alle Blätter bis auf die ersten beiden.
Füge im Blatt 2 in Zeile 1 deine Spaltenüberschriften aus Blatt 1 1:1 ein, leere den Inhalt der Zeile 2 und gib in der entsprechenden Spalte dein Filter-Kriterium ein.
Kopiere dann Blatt 2 so oft wie benötigt und passe jeweils den Namen des Kriteriums an.
hier ein Beispielmakro, das du an deine Gegebenheiten anpassen musst.
Gruß
Franz
Sub KopieAktionen()
Dim wksQuelle As Worksheet, lngZeile As Long
Dim wksZiel As Worksheet, lngZeile\_Z As Long
Const Spalte\_Datum As Long = 5 'Spalte F - ggf. anpassen
On Error GoTo Fehler
Set wksQuelle = ActiveWorkbook.Worksheets("Aktionsliste") 'Blattame ggf. anpassen
With wksQuelle
For lngZeile = 2 To .Cells(.Rows.Count, Spalte\_Datum).End(xlUp).Row
Set wksZiel = Worksheets(Format(.Cells(lngZeile, Spalte\_Datum), "DD.MM.YYYY")) 'Format ggf. anpassen
With wksZiel
lngZeile\_Z = .Cells(.Rows.Count, Spalte\_Datum).End(xlUp).Row
wksQuelle.Rows(lngZeile).Copy Destination:=.Rows(lngZeile\_Z + 1)
End With
NextLngZeile:
Next lngZeile
End With
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case 9
If MsgBox("Fehler-Nr.: " & .Number & vbLf & .Description & vbLf \_
& "Blatt für Datum " & Format(wksQuelle.Cells(lngZeile, Spalte\_Datum), "DD.MM.YYYY") \_
& " nicht vorhanden!", \_
vbQuestion + vbOKCancel, "Fehler-Meldung") = vbOK Then
Resume NextLngZeile
End If
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub
Hallo smilz,
woran hängt es den konkret - wieviel Code hast du schon?
Im Prinzip brauchst du doch nur eine Schleifen bauen, in der Ausgangstabelle nach dem Datum suchen-> diese Zeile markieren und kopieren-> dann in das neue Blatt einfügen.
Weiter geht’s zum nächsten Eintrag (also sollte man die letzte Position vielleicht speichern) bis das Tabellenblatt abgearbeitet ist.
Du siehst so etwas kann man nicht aus dem Ärmel schütteln wenn man nicht mal die Tabelle hat.
Viel Spaß bei Programmieren.
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
hierzu benötigt man schon ein paar mehr Infos.
Wo stehen die jeweiligen Datumsangaben?
Wann sollen die neuen Blätter erstellt werden?
Soll jedesmal, wenn ein neues Datum hinzugefügt wird, ein neues Blatt erzeugt werden … etc.
Fragen, ohne deren Antworten man keine zufriedenstellende Hilfestellung geben kann.
Gruß,
Ptonka