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方法。如果可能的話，只要將您的行爲應用於範圍，通常會更好。

我以上面的一些變化爲例。