如何遍歷工作簿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

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