Check all specified sheets for expired date in column and copy the row info to expired sheet

[slayer1957]

I have a few sheets, sheets 1-6 which has a date starting from column "I" and row "2". I have some code that can check a sheet in that column if the date has passed and copy the row to Expired sheet once you click a button.

I just need it to check all specified sheets 1-6 or per name of sheet and copy all data making a list of all the expired rows to the Expired sheet as a Module vba. It must copy data continuing until all rows have been copied.

Sub License_Check()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = Sheets("Expired").Cells(Rows.Count, "A").End(xlUp).Row + 1
    For i = 3 To Lastrow
        If Cells(i, 9) < Date Then
            Rows(i).Copy Destination:=Sheets("Expired").Rows(Lastrowa)
            Lastrowa = Lastrowa + 1
        End If
    Next
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Try this:
This script looks at sheet 2 to last sheet in workbook

Sub License_Check()
'Modified  12/4/2020  7:31:48 AM  EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Long
Dim b As Long
For b = 2 To Sheets.Count

With Sheets(b)
    Lastrow = .Cells(Rows.Count, "I").End(xlUp).Row
    Lastrowa = Sheets("Expired").Cells(Rows.Count, "I").End(xlUp).Row + 1
        For i = 3 To Lastrow
            If .Cells(i, 9) < Date And .Cells(i, 9).Value <> "" Then
                .Rows(i).Copy Destination:=Sheets("Expired").Rows(Lastrowa)
                Lastrowa = Lastrowa + 1
            End If
    Next
    End With
    Next
   
Application.ScreenUpdating = True
End Sub