Macro to delete and replace cell contents required

DancingElvisLives,

I came up with a macro that does what you need it to do, but your workbook has links in it that were interrupting the macro. I think that's just because I don't have the workbook it was trying to access (was looking in a network drive, the K: drive, for: K:\Energy Department Folder\IServe 3\IServe 4.xls)

If you have access to that workbook, maybe the macro will work for you. I copied your data without links into a separate test workbook, and in there the macro ran with no problems. Here's the code:

Sub FindWashUps()
    
    Application.ScreenUpdating = False
    
    Dim LastItem As Long:       LastItem = ActiveSheet.Range("I" & Rows.Count).End(xlUp).Row
    Dim CurrentItem As Long:    CurrentItem = 22
    While CurrentItem <= LastItem
        If ActiveSheet.Range("I" & CurrentItem).Value = "No" Then
            Application.CutCopyMode = False
            ActiveSheet.Range("B" & CurrentItem & ":E" & CurrentItem).Copy
            If IsEmpty(Sheets("Sheet2").Range("A1")) Then
                Sheets("Sheet2").Range("A1").PasteSpecial
            Else
                Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
            End If
            ActiveSheet.Range("B" & CurrentItem & ":E" & CurrentItem).ClearContents
            ActiveSheet.Range("C" & CurrentItem).Value = "Wash Up Required"
        End If
        CurrentItem = CurrentItem + 1
    Wend
    
    CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

Hope that helps,
~tigeravatar