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

Question

已编辑。试图通过整个 excel 工作簿循环我当前的 VBA 代码，已尝试 For Each ws In Sheets 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

标签： excelvbaloopsworksheet

Answer 1

插入多行

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

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