Sub УдалениеСтрокПоНесколькимУсловиям()
Dim iRange As Range
Dim TextToFindArray As Variant
Dim i As Long
   TextToFindArray = Array("Поволжский", "РОСП", "ЦКСЗН", "УФССП", "УФПС", "Монтаж")
   With Application
       .ScreenUpdating = False
       .Calculation = xlCalculationManual
       For i=0 to Ubound(TextToFindArray)
           With ActiveSheet.Cells
               Set iRange =.Find(What:=TextToFindArray(i), LookIn:= xlValues, LookAt:=xlPart)
               If Not iRange Is Nothing Then
                   Do
                       iRange.EntireRow.Delete
                       Set iRange =.Find(What:=TextToFindArray(i), LookIn:=xlValues, LookAt:=xlPart)
                   Loop While Not iRange Is Nothing
               End If
           End With
       Next i
       .Calculation = xlCalculationAutomatic
       .ScreenUpdating = True
   End With
End Sub