Habe es ebenfalls ausgeführt und klappt auch.
Wie kriege ich es hin, das nur die Zeilen kopiert werden
in den auch ein Datum steht.
Die Zeilen in denen noch kein Datum steht sollen unverändert bleiben.
MfG Micha
MfG Micha
das ist eben der Nachteil, wenn ein neuer Beitrag angefangen wird für ein altes Problem die Übersichtlichkeit geht verloren. Vielleicht erinnnert sich Rainer noch an das Problem und die vorgeschlagene Lösung und kann die eine neue Lösung Posten. Ich würde schreiben für alle anderen sieht es schlecht aus.
Gruß Hajo
Habe diese Anfrage auch im alten Beitrag "Datum älter als 5 Tage"
gestellt. Da aber keine Antwort kam,deshalb neuer Versuch.
Hier noch mal die Lösung von Rainer, die auch geht, bis auf
die Zeilen ohne Datum, die unverändert bleiben sollen.
Sub Delete_Old_Rows()
Dim i As Integer, CrWks1 As Long, CrWks2 As Long
Dim wks1 As Worksheet, wks2 As Worksheet
Set wks1 = Worksheets("Tabelle1")
Set wks2 = Worksheets("Tabelle2")
CrWks1 = 65536
CrWks2 = 65536
If wks1.Cells(CrWks1, 1) = "" Then
CrWks1 = wks1.Cells(CrWks1, 1).End(xlUp).Row
End If
If wks2.Cells(CrWks2, 1) = "" Then
CrWks2 = wks2.Cells(CrWks2, 1).End(xlUp).Row
End If
For i = CrWks1 To 1 Step -1
If Format(wks1.Cells(i, 1), "dd.mm.yy") < Format(Now() - 5, "dd.mm.yy") Then
CrWks2 = CrWks2 + 1
wks1.Rows(i).Copy Destination:=wks2.Rows(CrWks2)
wks1.Rows(i).Delete Shift:=xlDown
End If
Next i
End Sub
MfG Micha
es sei mir gestattet mein Wochenende so zu verbringen wie ich es gerne hätte :-))
Sub Delete_Old_Rows()
Code eingefügt mit Syntaxhighlighter 1.14
Dim i As Integer, CrWks1 As Long, CrWks2 As Long, crwks As Long
Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet
Set wks1 = Worksheets("Tabelle1")
Set wks2 = Worksheets("Tabelle2")
Set wks3 = Worksheets("Tabelle3")
CrWks1 = 65536
CrWks2 = 65536
If wks1.Cells(CrWks1, 1) = "" Then
CrWks1 = wks1.Cells(CrWks1, 1).End(xlUp).Row
End If
If wks2.Cells(CrWks2, 1) = "" Then
CrWks2 = wks2.Cells(CrWks2, 1).End(xlUp).Row
End If
For i = CrWks1 To 1 Step -1
If Format(wks1.Cells(i, 1), "dd.mm.yy") < Format(Now() - 5, "dd.mm.yy") Then
CrWks2 = CrWks2 + 1
wks1.Rows(i).Copy Destination:=wks2.Rows(CrWks2)
wks1.Rows(i).Delete Shift:=xlDown
End If
Next i
'---
'Ab hier werden nur die mit leerem Datum kopiert
'---
CrWks1 = 65536
CrWks3 = 65536
If wks1.Cells(CrWks1, 1) = "" Then
CrWks1 = wks1.Cells(CrWks1, 1).End(xlUp).Row
End If
If wks3.Cells(CrWks3, 1) = "" Then
CrWks3 = wks3.Cells(CrWks3, 1).End(xlUp).Row
End If
For i = 1 To CrWks1
If wks1.Cells(i, 1) = "" Then
CrWks3 = CrWks3 + 1
wks1.Rows(i).Copy Destination:=wks3.Rows(CrWks3)
End If
Next i
End Sub
Gruss Rainer
Sorry, so wars nicht gemeint.
Habe eben gelesen, daß mein Text mißverständlich ist.
In Tabelle 1 sollen die Ohne Datum stehen bleiben und nicht mitkopiert werden.
Mfg Micha
also wenn ich dich richtig verstanden habe, willst du alle Daten kopieren, ausser den Zeilen, in denen im Feld Datum kein Wert steht.
Sub Delete_Rows_without_Date()
Code eingefügt mit Syntaxhighlighter 1.14
Dim i As Integer, CrWks1 As Long, CrWks2 As Long, crwks As Long
Dim wks1 As Worksheet, wks2 As Worksheet
Set wks1 = Worksheets("Tabelle1")
Set wks2 = Worksheets("Tabelle2")
CrWks1 = 65536
CrWks2 = 65536
If wks1.Cells(CrWks1, 1) = "" Then
CrWks1 = wks1.Cells(CrWks1, 1).End(xlUp).Row
End If
If wks2.Cells(CrWks2, 1) = "" Then
CrWks2 = wks2.Cells(CrWks2, 1).End(xlUp).Row
End If
For i = CrWks1 To 1 Step -1
'Jetzt werden alle Zeilen kopiert,
'wenn in der Zelle Datum kein Wert steht
If wks1.Cells(i, 1) <> "" Then
CrWks2 = CrWks2 + 1
wks1.Rows(i).Copy Destination:=wks2.Rows(CrWks2)
wks1.Rows(i).Delete Shift:=xlDown
End If
Next i
End Sub
Gruss Rainer
Ja richtig, haut hin,
nur sollte jetzt die Bedingung mit dem Datum,
Kopiere Zeile älter als X Tage noch erfüllt werden.
Gruß Micha
Habe meine Aufgabe gelöst.
Besten Dank für die Lösung.
Schönen Sonntag noch.
Mfg Micha