Sub CopyRows()
Application.ScreenUpdating = False
Dim LastRow As Long, arr As Variant
arr = Array("5015", "5048", "5058", "6425")
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With Sheets("Sheet1")
.Range("A1:Z" & LastRow).AutoFilter Field:=4, Criteria1:="=1603", Operator:=xlOr, Criteria2:="=4995"
.AutoFilter.Range.Offset(1).Copy Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Offset(1)
.Range("A1:Z" & LastRow).AutoFilter Field:=4, Criteria1:="=1573", Operator:=xlOr, Criteria2:="=6073"
.AutoFilter.Range.Offset(1).Copy Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, "A").End(xlUp).Offset(1)
.Range("A1:Z" & LastRow).AutoFilter 4, arr, xlFilterValues
.AutoFilter.Range.Offset(1).Copy Sheets("sheet4").Cells(Sheets("sheet4").Rows.Count, "A").End(xlUp).Offset(1)
.Range("A1").AutoFilter
End With
Application.ScreenUpdating = True
End Sub