如何遍历工作簿VBA中的所有工作表

问题描述

已编辑。 试图通过整个Excel工作簿循环我当前的VBA代码，已经尝试过 对于工作表ws.Activate中的每个ws.Activate但不起作用，它不会在整个工作簿中循环，而仅在我所在的工作表中循环。任何帮助表示赞赏！

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

解决方法

插入多行

在工作簿的每个工作表的单元格中，尝试查找指定的字符串，并在每个“找到的”单元格下方插入指定的行数。

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