How do I loop the following code through workbook?

[vllgv]

Sub Macro6()

Cells.Find(What:="AUTO.WHSE.", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate


Rows(ActiveCell.Row & ":" & (ActiveCell.Row + 2)).Delete


End Sub

 

[Momentman]

Untested code, but give it a try

Sub Macro6()
    Dim ws As Worksheet

    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
        Cells.Find(What:="AUTO.WHSE.", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
            
        Rows(ActiveCell.Row & ":" & (ActiveCell.Row + 2)).Delete
    Next ws
    Application.ScreenUpdating = True
End Sub

 

[vllgv]

Mr. Momentman,

Thank you very much for the code. This is a MrExcel problem I am solving for someone else and would like to give you credit for your efforts.

I have tested the code:

It works when there is one instance on one or more sheets.

When there are 2 or more instances on one sheet, there is no error, but it only finds the first one.

'Great day,

v

 

[vllgv]

MomentMan,

I was able to figure it out. Thanks again for your help.

Sub FindDelete()
    Dim ws As Worksheet
    Dim c As Range
    Dim c_Address As String
    On Error Resume Next
    Application.ScreenUpdating = False
    
    For Each ws In ActiveWorkbook.Worksheets
      ws.Activate
      With Range("A1:D100") 'Update range!
        Set c = .Find(What:="AUTO.WHSE.")
        If Not c Is Nothing Then
            c_Address = c.Address
            Do
              c.Rows(.Row & ":" & (.Row + 2)).Delete
              Set c = .Find(What:="AUTO.WHSE.")
            Loop While Not c Is Nothing And c.Address <> c_Address
        End If
      End With
    Next ws
    Sheets(1).Select
    Range("A1").Activate
    
    Application.ScreenUpdating = True
 End Sub