Sub CombineAllSheets()
Dim ms As Worksheet, LRms As Long, sh As Worksheet, LR As Long, i As Long
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
On Error Resume Next
Set ms = Sheets("Completed")
With Sheets("Started")
LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
For i = 2 To LR
If Trim(.Cells(i, "F").Value) <> vbNullString Then
If Trim(.Cells(i, "H").Value) <> "Transfer Accepted" Then
.Rows(i).Cut ms.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
End If
Next i
End With
Application.CutCopyMode = 0
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub
Bookmarks