How to loop through all sheets in the workbook VBA

Question

Edited. Trying to loop my current VBA code through entire excel workbook, have tried For Each ws In Sheets ws.Activate but doesn't work, it doesn't loop through the entire workbook, but only for the sheet I'm on. Any help appreciated!

Sub InsertRows()


 Dim ws As Worksheet
 Dim rng As Range
 Dim FirstRange As Excel.Range


    For Each ws In Sheets
        ws.Activate
 
 Set rng = ActiveSheet.Cells.Find(What:="*XXX*", MatchCase:=False, Lookat:=xlWhole)
 Do While Not rng Is Nothing
 If FirstRange Is Nothing Then
 Set FirstRange = rng
 Else
 If rng.Address = FirstRange.Address Then
 Exit Do
 End If
 End If
 
 If WorksheetFunction.CountBlank(rng.Offset(1).EntireRow) <> Columns.Count Then
 rng.Offset(1).EntireRow.Insert
  rng.Offset(1).EntireRow.Insert
 
 End If
 
 Set rng = ActiveSheet.Cells.FindNext(After:=rng.Cells(1))
 Loop
 
Next ws
End Sub

I don't see the For Each ws In Sheets in your code. Also, "..doesn't work* doesn't give us any information on what the actual issue is. What happens when you run the loop? it never steps into the loop? It throws an error? if so, what error does it throw and on which line? — Zac
Do your code at least compiles? It ends with a Loop but as @Zac points out there is no For. Also, if you want to loop through all your sheets only to process some data there is no need to activate them. Just refer to each one using Set rng = ws.Cells instead of Set rng = ActiveSheet.Cells. — romulax14

VBasic2008 VBasic2008 · Accepted Answer · 2020-09-18T14:16:49

Insert Multi Rows

In cells of each worksheet of a workbook, tries to find a specified string and below each 'found' cell, inserts a specified number of rows.

Sub insertMultiRows()

    Const NumRows As Long = 2
    Const Criteria As String = "XXX"
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containing this code.
    
    Dim ws As Worksheet             ' Current Worksheet
    Dim cel As Range                ' Current Found Cell in Current Worksheet
    Dim FirstCellAddress As String  ' First Cell Address in Current Worksheet
    
    ' Loop through all worksheets in workbook.
    For Each ws In wb.Worksheets
        
        ' Try to define the First Cell containing Criteria.
        Set cel = ws.Cells.Find(What:=Criteria, _
                                After:=ws.Cells(ws.Rows.Count, _
                                                ws.Columns.Count), _
                                LookIn:=xlFormulas, _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows)
        
        ' Check if Criteria was found.
        If Not cel Is Nothing Then
            
            ' Define First Cell Address.
            FirstCellAddress = cel.Address
            
            ' Insert rows and try to find next occurrences of Criteria.
            Do
                ' Check if next row is not blank.
                If WorksheetFunction.CountBlank(cel.Offset(1).EntireRow) _
                  <> Columns.Count Then
                    ' Insert rows.
                    cel.Offset(1).Resize(NumRows).EntireRow.Insert
                End If
                ' Try to find the next occurrence of Criteria. You don't want
                ' to find multiple instances in row: use last cell in row.
                Set cel = ws.Cells.FindNext(After:=ws.Cells(cel.Row, _
                                                            ws.Columns.Count))
            ' Check if current cell address is different then First Cell Address
            ' (to avoid infinite loop).
            Loop While cel.Address <> FirstCellAddress
        
        End If
    
    Next ws

End Sub

How to loop through all sheets in the workbook VBA

1 Answers

Insert Multi Rows