Looping through & cutting and pasting values between two dates

Hi,

I am trying to cut all rows with the date less than 2 days older than the current date. Cut and paste it into a new worksheet in same workbook and save it into a specific folder.

Here is my code:

Sub Final_Cleanup()

Dim EndDate As Date
Dim StartDate As Date
Dim i As Long

today = Date
StartDate = today - 2
EndDate = today

Worksheets("Sheet1").Activate

With Sheets("Sheet1")
LR = .Cells(Rows.Count, 1).End(xlUp).Row
For i = LR To 2 Step -1
If .Cell(i, 1).Value < StartDate Then
.Rows(i).EntireRow.Cut
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "Archive"
ActiveSheet.Range("A1").Select
ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste

End If
Next i

End With

ActiveSheet.SaveAs Filename:="C:\Users\anneg\Desktop\Archive\Archive.xlsm"


End Sub

I am getting an error on the line :

If .Cell(i, 1).Value < StartDate Then

Saying Object doesn't support this property or method.

Any ideas how I can solve this?

Thanks

Dummy Workbk.xlsm

Hi this is a dummy workbook. So I want only the dates from current date to current date-2 to be cut and pasted into new worksheet.

Thanks for your help.

Thank you Leith Ross,

I have another error:

Sub Final_Cleanup()

Dim EndDate As Date
Dim StartDate As Date
Dim i As Long

today = Date
StartDate = today - 2
EndDate = today

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Archive"
Worksheets("Sheet1").Activate

With Sheets("Sheet1")
LR = .Cells(Rows.Count, 1).End(xlUp).Row
For i = LR To 2 Step -1
If .Cells(i, 1).Value < StartDate Then
.Rows(i).EntireRow.Cut
.Rows(i).Paste Destination:=Worksheets("Archive").Cells(Rows.Count, 1).End(xlUp).Offset(1)

End If
Next i

End With

ActiveSheet.SaveAs Filename:="C:\Users\anneg\Desktop\Archive\Archive.xlsm"


End Sub

on line

         .Rows(i).Paste Destination:=Worksheets("Archive").Cells(Rows.Count, 1).End(xlUp).Offset(1)

Thankk you so much!!! Amazing

Hi so I have run into an unexpected problem.

with this code

Sub Final_Cleanup()
    Dim StartDate As Date, EndDate As Date
    Dim i As Long
     
    StartDate = DateSerial(Year(Date - 2), Month(Date - 2), Day(Date - 2))
    EndDate = DateSerial(Year(Date), Month(Date), Day(Date))
     
     
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Archive"
     
    With Worksheets("Sheet1")
        For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
            If CLng(.Cells(i, 1).Value) < CLng(StartDate) Then
                .Rows(i).Copy Destination:=Worksheets("Archive").Cells(Rows.Count, 1).End(xlUp).Offset(1)
                .Rows(i).Cells.Clear
            End If
        Next i
    End With
    Call Tester2a
End Sub

It gives a type error when I have the word "1 target" on column A more than once. I have the word "1 target" about 1000 times down column A and then the date begins on column A. So I want the code to ignore the word "1 target". I put it into the if statement and said

 If CLng(.Cells(i, 1).Value) < CLng(StartDate) And CLng(.Cells(i, 1).Value)<> "1 target" Then

but it gave me an error.

Any help please?