2012-03-25 79 views
0

我有多个Excel工作簿每个代表天的数据,每个工作簿具有代表当天每个事件多张纸..运行,这样多的宏在多个Excel工作簿 - VBA

我需要按顺序运行6个宏横跨工作簿中的每张工作表,然后转到下一个工作簿(所有工作簿位于桌面上的同一文件夹中)

此刻,我正在使用此(下面)按顺序在所有工作表中运行宏但我很难试图让所有的工作簿上运行

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 

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

+0

所有的工作簿都是最初打开的,还是您想打开/处理/关闭每个工作簿?工作簿的处理顺序也是重要的吗? – 2012-03-25 20:15:30

+0

工作簿都是最初关闭的,除了id从哪个工作簿运行它们以外,工作簿顺序无关紧要,只是宏在各个工作表上的运行顺序。 – sam 2012-03-25 20:22:40

回答

4

我没有你的宏,所以我创建了虚拟宏输出一些值到立即窗口的每一个工作簿中的每个表(除了包含宏工作簿)。

您的代码似乎取决于激活每个工作表的输出宏。这是不好的做法。我将工作簿和工作表名称传递给宏。我输出单元格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 
1

伪代码大纲:

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 
相关问题