Sub Dosomething()

   Dim xSh As Worksheet

   Application.ScreenUpdating = False

   For Each xSh In Worksheets

       xSh.Select

       Call RunCode

   Next

   Application.ScreenUpdating = True

End Sub

Sub RunCode()

   'your code here

   Dim ra As Range, delra As Range

   Application.ScreenUpdating = False    ' отключаем обновление экрана

   ' ищем и удаляем строки, содержащие заданный текст

   ' (можно указать сколько угодно значений, и использовать подстановочные знаки)

   УдалятьСтрокиСТекстом = Array("Наименование *", "ПО ОБЛАСТИ", _

                                 "текст?", "*Подпись*")

   ' перебираем все строки в используемом диапазоне листа

   For Each ra In ActiveSheet.UsedRange.Rows

       ' перебираем все фразы в массиве

       For Each word In УдалятьСтрокиСТекстом

           ' если в очередной строке листа найден искомый текст

           If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then

               ' добавляем строку в диапазон для удаления

               If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)

           End If

       Next word

   Next

   ' если подходящие строки найдены, то: (оставьте одну из 2 следующих строк)

   If Not delra Is Nothing Then delra.EntireRow.Hidden = True    ' скрываем их