Excel VBA循环遍历所有工作簿和所有工作表

Question

我想创建一个Excel VBA循环遍历所有的.xlsx文件和这些文件中的所有工作表。然而，我的代码只会处理第一个工作表而不是所有工作表。请问是否有问题？非常感谢！

Sub Rollup()

Dim wb As Workbook, MyPath, MyTemplate, MyName
Dim ws As Worksheet

MyPath = "I:\Reports\Rollup Reports\"
MyTemplate = "*.xlsx"  
MyName = Dir(MyPath & MyTemplate)    
Do While MyName <> ""
    Set wb = Workbooks.Open(MyPath & MyName)
        For Each ws In wb.Worksheets
            LocationReport             
        Next ws
    wb.Close True    
    MyName = Dir()                 
Loop
End Sub

Sub LocationReport()

Application.ScreenUpdating = False

Range("N4").Select
ActiveCell.FormulaR1C1 = "1"
Range("N4").Select
Selection.Copy
Range("B2:J7,B10:J20,B23:J28").Select
Range("B23").Activate
Selection.PasteSpecial Paste:=xlAll, Operation:=xlMultiply, SkipBlanks:= _
    False, Transpose:=False
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Application.ScreenUpdating = True

End Sub

- user5953931

Answer 1

一种可扩展且面向对象的处理方式是将工作表作为参数传递：

Sub Rollup()
    Dim wb As Workbook, MyPath, MyTemplate, MyName
    Dim ws As Worksheet

    MyPath = "I:\Reports\Rollup Reports\"
    MyTemplate = "*.xlsx"
    MyName = Dir(MyPath & MyTemplate)
    Do While MyName <> ""
        Set wb = Workbooks.Open(MyPath & MyName)
            For Each ws In wb.Worksheets
                LocationReport (ws)
            Next ws
        wb.Close True
        MyName = Dir()
    Loop
End Sub

Sub LocationReport(ByRef ws As Worksheet)
    Application.ScreenUpdating = False

    With ws
      .Range("N4").FormulaR1C1 = "1"
      .Range("N4").Copy
      .Range("B2:J7,B10:J20,B23:J28").Select
      .Range("B23").Activate
      .Selection.PasteSpecial Paste:=xlAll, Operation:=xlMultiply, SkipBlanks:= _
            False, Transpose:=False

      With .Rows("1:1")
        Application.CutCopyMode = False
        .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      End With
    End With

    Application.ScreenUpdating = True
End Sub

此外，略有点偏题，但我尽量避免使用Range.Select和Selection.Method方法。通常情况下，如果可能的话，直接将操作应用于范围会更好。

我已经对上面的一些更改进行了示例。

- Hambone

Answer 2

在你的每一个ws循环中添加ws.Activate试试：

For Each ws In wb.Worksheets
    ws.Activate
    LocationReport             
Next ws

- SincereApathy

---

完美运行。非常感谢！ - user5953931