Home > OS >  Open workbooks based on a list and run a specific macro
Open workbooks based on a list and run a specific macro

Time:12-31

I'm attempting to open all of the workbooks in this range and run their macros. The idea is to open the first workbook, run the macro, and then close it before moving on to the next. The name of the macro is the same across all workbooks. I'm running the code and I'm getting (subscript out of range) error. Any help would be much appreciated.

Sub files_export()

Dim wb As Workbook
Set wb = ThisWorkbook
Dim startsheet As Worksheet
Set startsheet = wb.Worksheets("Start")
    
Dim linkrange As Range
Set linkrange = startsheet.Range("C4:C21") 
    
    Dim y As String
    Dim c As Range
    
    For Each c In linkrange
        If c.Value <> "" Then
           y = c.Value
           Workbooks.Open (y)
           Workbooks(y).Application.Run ("macro1")
           Workbooks.close (y)
        End If
    Next c

End Sub

CodePudding user response:

Please, try replacing of:

Workbooks(y).Application.Run ("macro1")

with:

Application.Run y & "!.macro1")

Note1: macro1 should exist in a standard module.

Note2: using the workbook full name will make the y workbook opening, if not already open... You can use the workbook Name, extracting it from the full name, but this will work only if the workbook in discussion is open (like in your case).

CodePudding user response:

Run Macro In Another Workbook

Option Explicit

Sub FilesExport()

    Const dName As String = "Start"
    Const FilePathsRangeAddress As String = "C4:C21"
    Const ModuleName As String = "" ' or e.g. "Module1"
    Const MacroName As String = "Macro1"

    Dim ModName As String: ModName = ModuleName
    If Len(ModName) > 0 Then ModName = ModName & "."

    Dim dwb As Workbook: Set dwb = ThisWorkbook
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dName)
    
    Dim fprg As Range: Set fprg = dws.Range(FilePathsRangeAddress)
    
    Dim swb As Workbook
    Dim swbName As String
    Dim sCell As Range
    Dim sMacroString As String
    
    For Each sCell In fprg.Cells
        swbName = CStr(sCell.Value)
        If Len(swbName) > 0 Then
           Set swb = Workbooks.Open(swbName)
           sMacroString = "'" & swb.Name & "'!" & ModName & MacroName
           swb.Application.Run sMacroString
           swb.Close SaveChanges:=False ' maybe 'True' ?
        End If
    Next sCell

End Sub
  • Related