I have multiple excel workbooks each representing a days data, each workbook has multiple sheets representing each event on the day..
i need to run 6 macros in order across each sheet in a workbook and then move on to the next workbook (all the workbooks are in the same folder on the desktop)
at the moment im using this (below) to run the macros in order across all the sheets but im having trouble trying to get somthing to run across all of the workbooks
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
any idea how i might do this ?
Answer
I do not have your macros so I have created dummy macros that output some values to the Immediate window for every sheet of every workbook (except the workbook containing the macro).
You code appears to depend on the output macro activating each worksheet. This is bad practice. I pass the workbook and the worksheet name to the the macros. I output the value of cell A1 (.Cells(1, 1).Value
) to show how it is done.
I hope this is enough to get you started. Ask if anything is unclear.
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
No comments:
Post a Comment