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

我想要创build一个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循环中添加ws.Activate：

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

Answer 2

一个可扩展的和OOP的esque处理方式是通过工作表作为参数：

 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方法。 只要有可能，只要将你的行为应用于范围就更好了。

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