Macro/VBA to move + delete entries based on date

joeycc 

Sub fourteendays()

Dim ws As Worksheet
Dim ws1 As Worksheet
Dim lastrow As Long
Dim i As Long
Dim k As Long
Dim todaydate As Date

todaydate = Date

Set ws = Worksheets("Tabelle1")
Set ws1 = Worksheets("Tabelle2")

k = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
For i = 2 To lastrow
    
If Cells(i, 1).Value <> "" Then
If Cells(i, 1).Value < todaydate - 14 Then

    ws.Range("A" & i, "I" & i).Copy Destination:=ws1.Range("A" & k + 1)
    k = k + 1
    ws.Rows(i).Delete
    i = i - 1
     
Else
End If
Else
End If

Next i

Application.CutCopyMode = False

End Sub

Maybe with these lines of code. In the attached file you can click the button in cell N2 to run the macro. The dates are in column A of sheet "Tabelle1" and in column B to K are random numbers for this example.