Aug 17 2022 04:47 AM
Hey!
I haven't been able to figure this out for about a week now. I have a sheet for work that is used to check if clients have visited within the past two weeks. I would like to move rows over 14 days old to another sheet on the same file and then delete those same entries from the main sheet. The dates are stored in column a formatted as dd.mm.yyyy. I would ideally like to only move columns a-i, because columns j and k have data that doesn't need to be carried over, but if that is more trouble than it is worth the whole row is fine.
I also am not super familiar with running Macros/VBAs and am wondering if it runs each time the sheet is opened?
Any help is greatly appreciated!
Aug 17 2022 04:53 AM
I'd leave all data on the one sheet, and use a filter on the date column to show or hide rows as needed.
Aug 17 2022 05:39 AM
Aug 20 2022 04:23 AM
SolutionSub 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.
Aug 20 2022 05:00 AM
Aug 28 2024 07:31 PM
@OliverScheurich This is great. Is there a way to do this exact thing except have the final destination be a worksheet in another workbook instead?
Aug 29 2024 03:14 AM
Change the line
Set ws1 = Worksheets("Tabelle2")
to
Set ws1 = Workbooks("OtherWorkbook.xlsx").Worksheets("OthwerWorksheet")
substituting the correct names, of course.
Aug 20 2022 04:23 AM
SolutionSub 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.