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 

Answer 1

尝试增加ws.Activate你里面每个WS循环：

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

Answer 2

一个可扩展的，面向对象式的方法来处理这将是工作表作为参数传递：

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方法。如果可能的话，只要将您的行为应用于范围，通常会更好。

我以上面的一些变化为例。