Sub Search_In_All_Sheets()
    Dim FirstAddress As String
    Dim Rng As Range
    Dim sh As Worksheet
    
    On Error Resume Next
   
    For Each sh In ActiveWorkbook.Worksheets
        With sh.Cells
                Set Rng = .Find(What:="WPID", _
                                LookIn:=xlFormulas, _
                                LookAt:=xlWhole, _
                                MatchCase:=False)
'''Лишние аргументы
'''                                SearchOrder:=xlByRows, _
'''                                SearchDirection:=xlNext, _
'''                                After:=.Cells(.Cells.Count), _

                If Not Rng Is Nothing Then
                    FirstAddress = Rng.Address
                    Do
                        Rng.Font.Color = RGB( 150 ,  0 ,  0 )
'''                        Rng.Select 'Лишнее
'''                        ActiveCell.Offset(0, 1).Font.Color = RGB(0, 0, 0)
                        Rng.Offset( 0 ,  1 ).Font.Color = RGB( 0 ,  0 ,  0 )
'''Переменная не описана и не используется
'''                        wpid = ActiveCell.Offset(0, 1).Value 
'''                        wpid = Rng.Offset(0, 1).Value 
                        'MsgBox wpid
                        Set Rng = .FindNext(Rng)
'''Rng can't be Nothing
'''                  Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress 
                    Loop Until Rng.Address = FirstAddress
                End If
        End With
    Next sh
End Sub