запуск нескольких макросов по порядку в нескольких книгах Excel - vba

Question

У меня есть несколько книг Excel, каждая из которых представляет данные дней, каждая книга имеет несколько листов, представляющих каждое событие в день.

Мне нужно запустить 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

есть идеи, как мне это сделать?

Answer 1

У меня нет ваших макросов, поэтому я создал фиктивные макросы, которые выводят некоторые значения в окно Immediate для каждого листа каждой книги (кроме книги, содержащей макрос).

Ваш код зависит отвыходной макрос, активирующий каждый лист.Это плохая практика.Я передаю рабочую книгу и имя рабочей таблицы макросам.Я вывел значение ячейки 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