Hi B_A5,
Welcome to the forum
Option Explicit
Sub on_hire()
Dim ws As Worksheet
Dim wsd As Worksheet
Dim lr As Long
Dim lr2 As Long
Application.ScreenUpdating = False
Set wsd = ThisWorkbook.Worksheets("On Hire")
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Summary", "Transaction Report", "Template", "On Hire"
'do nothing
Case Else
lr = ws.Range("C" & Rows.Count).End(xlUp).Row 'last row with data in column C (change as needed to column ALWAYS having data)
If lr < 5 Then GoTo next_sheet 'no rows with data on the sheet
ws.Range("B4:K" & lr).AutoFilter field:=8, Criteria1:="ON"
ws.Range("B5:K" & lr).SpecialCells(xlCellTypeVisible).Copy
lr2 = wsd.Range("C" & Rows.Count).End(xlUp).Row + 1 'first blank row on the On Hire sheet based on column C
wsd.Range("B" & lr2).PasteSpecial xlPasteValues
wsd.Range("B" & lr2).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
ws.AutoFilterMode = False
End Select
next_sheet:
Next ws
Application.ScreenUpdating = True
End Sub
Bookmarks