Excel Zeilen in Abhängigkeit des Datums kopieren

Hallo,

ich habe folgendes Problem. Aus einer bestehenden Aufgabenliste sollen ganze Zeilen in verschiedene Tabellenblätter kopiert werden.

Ich habe bereits ein Makro geschrieben, das neue Blätter erstellt, deren Titel das Fälligkeitsdatum der Aufgaben ist.

jetzt benötige ich einen Code, der die Zeilen mit gleichem Datum in die Blätter mit dem entsprechendem Datum kopiert.

Ich habe bereits Stunden mit der Internet suche verbracht, aber nichts passendes bzw. hilfreiches gefunden. Kann mir hier vielleicht jemand helfen?

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?

Gruß Jürgen.D
PS. Email: [email protected]

Sorry,
mit Makros kenne ich mich nicht aus.
Gruß
Mike

Hallo Smilz

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

Grüsse Sebastian

Hallo,

jetzt benötige ich einen Code, der die Zeilen mit gleichem
Datum in die Blätter mit dem entsprechendem Datum kopiert.

Code nach datum suchen

http://www.herber.de/forum/archiv/568to572/571032_Da…

kopieren mit makro recorder aufzeichnen, etwas modifizieren.

gruß fred

Grüezi smilz

Wenn Du dein Zieldatum in eine Zelle schreiben lässt (kann gut per VBA geschehen), dann kannst Du diese Mappe hier verwenden:

http://users.quick-line.ch/ramel/Files/spezialfilter…

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.

Mit freundlichen Grüssen

Thomas Ramel

  • MVP für MS-Excel -

Hallo

Also am einfachsten ist halt schon wenn man alles hat excel inkl. Makro.
Dazu eine kurze beschreibung.

Wieviel ist ihnen eine loesung wert?

Ist es fuer privat oder eine firma?

Klar kann man eine rudi… losung machen ich finde es halt muehsam allesselbst aufbauen und dann nochneine loesung erstellen.

Jo man muss auch leben. Und ich bin zur zeit arbeitslos…

Danke und gruss

Keymax

[email protected]

Hallo smilz,

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.

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

Hallo,

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