Copy, paste, delete row

[R0d]

Hi everyone

I am looking for a macro that will look through columns X, AA & AC which contain dates on sheet1. If any of the dates are more than 30 days old, copy the row and paste it into sheet2 under the last entry. Finally delete the row copied in sheet1.

Thanks in advance

 

[lrobbo314]

Where does your data begin and end in Sheet1? Are you copying from column A to column AC? Or does it extend further? Do you have a header row on sheet1?

 

[R0d]

Hi Irobbo314

The data for the columns X,AA & AC begins on row 5 and I would anticipate it would not extend any further than row 250. I would like to copy from column A to column AE. There are no header rows.

 

[lrobbo314]

Try the following code.

Sub copyover()
On Error GoTo ERH
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Dim AR() As Variant: AR = ws1.Range("A5:AE" & ws1.Range("A" & Rows.Count).End(xlUp).Row).Value
Dim LR As Long

For i = UBound(AR) To LBound(AR) Step -1
    If Now() - AR(i, 24) > 30 Or Now() - AR(i, 27) > 30 Or Now() - AR(i, 29) > 30 Then
        ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(1, 29).Value = Application.Index(AR, i, 0, 1)
        ws1.Rows(i).EntireRow.Delete
skip:
    End If
Next i

Exit Sub

ERH:

If Err.Number = 13 Then
    Resume skip
Else
    MsgBox "Error: " & Err.Description, vbCritical, "Error"
End If

End Sub

 

[R0d]

Just tried your code, but it is taking out the first 4 rows on sheet1. These rows need to stay.

 

[lrobbo314]

So rows 5-8 are being deleted? If so, what dates are in columns X, AA, and AC in those rows?

 

[R0d]

Hi Irobbo314

I think I have some corrupt data in the workbook somewhere, the other macros I have in the workbook are not running how they should either. Will resolve this issue and have another go at it later.

Thanks for your time.