URGENT: Macro to cut and paste rows in new sheet based on date

[forotherruns]

Hello

I have a very large workbook with a number of similar worksheets. In each sheet there is a column (say column O) with dates. I need a macro to cut an entire row(s) and place it in the first available (empty) row of a new sheet based on the date.

For example if in Sheet1 (named "2011"), when any date in column O is equal to TODAY or earlier (i.e. the date has passed), I want the macro to cut those rows from the sheet 2011 and place in the new sheet (say "Expired") starting from the first available row.

I would also want the macro to be able to do the same for other sheets, cut the expired rows and place them in the "Expired" sheet in the first empty row below all the other entries that are already there.

Any help on this will be greatly appreciated.

Cheers!!!

 

[alvinwlh]

Hi,

Hope it works for you:

Sub Cut_Paste()
Dim last_row, i, last_row_e As Integer
Dim sh As Sheets
Dim s
Dim my_range  as range
 
Set sh = Sheets
 
For Each s In sh
    If s.name <> "Expired" Then
        With Sheets(s.name)
            last_row = .Range("O" & Rows.count).End(xlUp).Row + 1
            For i = 1 To last_row
                If .Range("O" & i).Value <= Date And .Range("O" & i).Value <> "" Then
                    Set my_range = .Rows(i)
                    With Sheets("Expired")
                        last_row_e = .Range("O" & Rows.count).End(xlUp).Row + 1
                        .Rows(last_row_e).Value = my_range.Value
                    End With
                    .Rows(i).Delete
                End If
            Next
        End With
    End If
Next

End Sub

 

[forotherruns]

Hello Alvin

You are a lifesaver!!!! It worked like a charm!!! I just made a few modifications so that instead of Sheets(s.name), I had Sheets("2011") and I have the Macro in every sheet!!!!


Thank you so much for your prompt response!!!

This forum is excellent!!!!!!!!!!!!!!