在多个Excel工作簿中运行多个macros – vba

我有多个Excel工作簿，每个工作簿都代表一个date数据，每个工作簿有多个工作表，代表当天的每个事件。

我需要在工作簿中的每个工作表中按顺序运行6个macros，然后转到下一个工作簿（所有工作簿位于桌面上的同一个文件夹中）

目前即时通讯使用这个（下面）来运行所有表中的macros，但即时通讯有麻烦试图让所有的工作簿somthing运行

Sub RUN_FILL() Dim sh As Worksheet For Each sh In ThisWorkbook.Worksheets sh.Activate Call macro_1 Call macro_2 Call macro_3 Call macro_4 Call macro_5 Call macro_6 Next sh End Sub 

任何想法我可以做到这一点？

Answer 1

我没有macros，所以我创build了一些虚拟macros，为每个工作簿的每个工作簿（包含macros的工作簿除外）的立即窗口输出一些值。

您的代码似乎取决于激活每个工作表的输出macros。 这是不好的做法。 我将工作簿和工作表名称传递给macros。 我输出单元格A1（ .Cells(1, 1).Value ）的值来显示它是如何完成的。

我希望这足以让你开始。 询问有什么不清楚的地方。

 Option Explicit Sub ControlCall() Dim FileNameCrnt As String Dim InxWSheet As Long Dim MsgErr As String Dim PathCrnt As String Dim RowReportCrnt As Long Dim WBookCtrl As Workbook Dim WBookOther As Workbook Dim WSheetNameOtherCrnt As String If Workbooks.Count > 1 Then ' It is easy to get into a muddle if there are multiple workbooks ' open at the start of a macro like this. Avoid the problem. Call MsgBox("Please close all other workbooks " & _ "before running this macro", vbOKOnly) Exit Sub End If Application.ScreenUpdating = False Set WBookCtrl = ActiveWorkbook ' Assume all the workbooks to be processed are in the ' same folder as the workbook containing this macro. PathCrnt = WBookCtrl.Path ' Add a slash at the end of the path if needed. If Right(PathCrnt, 1) <> "\" Then PathCrnt = PathCrnt & "\" End If FileNameCrnt = Dir$(PathCrnt & "*.xl*") Do While FileNameCrnt <> "" If FileNameCrnt <> WBookCtrl.Name Then ' Consider all workbooks except the one containing this macro Set WBookOther = Workbooks.Open(PathCrnt & FileNameCrnt) For InxWSheet = 1 To WBookOther.Worksheets.Count WSheetNameOtherCrnt = WBookOther.Worksheets(InxWSheet).Name Call macro_1(WBookOther, WSheetNameOtherCrnt) Call macro_2(WBookOther, WSheetNameOtherCrnt) Call macro_3(WBookOther, WSheetNameOtherCrnt) Call macro_4(WBookOther, WSheetNameOtherCrnt) Call macro_5(WBookOther, WSheetNameOtherCrnt) Call macro_6(WBookOther, WSheetNameOtherCrnt) Next WBookOther.Close SaveChanges:=False End If FileNameCrnt = Dir$() Loop Application.ScreenUpdating = True End Sub Sub macro_1(WBookOther As Workbook, WSheetNameOtherCrnt As String) With WBookOther With .Worksheets(WSheetNameOtherCrnt) Debug.Print "1 " & WBookOther.Name & " " & _ WSheetNameOtherCrnt & " " & .Cells(1, 1).Value End With End With End Sub Sub macro_2(WBookOther As Workbook, WSheetNameOtherCrnt As String) With WBookOther With .Worksheets(WSheetNameOtherCrnt) Debug.Print "2 " & WBookOther.Name & " " & _ WSheetNameOtherCrnt & " " & .Cells(1, 1).Value End With End With End Sub Sub macro_3(WBookOther As Workbook, WSheetNameOtherCrnt As String) With WBookOther With .Worksheets(WSheetNameOtherCrnt) Debug.Print "3 " & WBookOther.Name & " " & _ WSheetNameOtherCrnt & " " & .Cells(1, 1).Value End With End With End Sub Sub macro_4(WBookOther As Workbook, WSheetNameOtherCrnt As String) With WBookOther With .Worksheets(WSheetNameOtherCrnt) Debug.Print "4 " & WBookOther.Name & " " & _ WSheetNameOtherCrnt & " " & .Cells(1, 1).Value End With End With End Sub Sub macro_5(WBookOther As Workbook, WSheetNameOtherCrnt As String) With WBookOther With .Worksheets(WSheetNameOtherCrnt) Debug.Print "5 " & WBookOther.Name & " " & _ WSheetNameOtherCrnt & " " & .Cells(1, 1).Value End With End With End Sub Sub macro_6(WBookOther As Workbook, WSheetNameOtherCrnt As String) With WBookOther With .Worksheets(WSheetNameOtherCrnt) Debug.Print "6 " & WBookOther.Name & " " & _ WSheetNameOtherCrnt & " " & .Cells(1, 1).Value End With End With End Sub 

Answer 2

伪代码大纲：

 For each file in folder ' I'd use the FileSystemObject for this Set wb = Workbooks.Open file For Each sh in wb.worksheets .... Next wb.save wb.close Next