Run macro for multiple excel files in a folder

Hi guys, i have a macro that i need to run on many excel files. All of the files are located in the same folder.

The macro, is a find/replace which uses data from a sheet ("sheet 2" in this case) and changes the data in "sheet 1".

All of the excel files have only one sheet and the sheet name is the same which the nam,e of the file. For example:

file name : 3 - 4
sheet name : 3 - 4

This is the macro that i use, big thanks to Leith Ross for writing it.

Sub MultiReplace()

  Dim Cell As Range
  Dim Dict As Object
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet
  
    Set Dict = CreateObject("Scripting.Dictionary")
    
      Set Wks = Worksheets("Sheet2")
    
      Set Rng = Wks.Range("A1")
      Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
      If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Wks.Range(Rng, RngEnd)
      
        For Each Cell In Rng
          If Not IsEmpty(Cell) Then
            If Not Dict.Exists(Cell.Value) Then Dict.Add Cell.Value, Cell.Offset(0, 1).Value
          End If
        Next Cell
        
      Set Wks = Worksheets("Sheet1")
    
      Set Rng = Wks.Range("A1:B1") 'include 2 columns to be searched
      Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
      If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Wks.Range(Rng, RngEnd)
        
        For Each Cell In Rng
          If Dict.Exists(Cell.Value) Then
             Cell.Offset(0, 0) = Dict(Cell.Value) 'change value of the cell
          End If
        Next Cell
  
End Sub

Also the method should allow me to change which macro I want to run.

Thanks a lot for the help

So i think i managed to make it work

In the MultiReplace sub I've done some modifications

Set Dict = CreateObject("Scripting.Dictionary")
    
      Set Wks = Workbooks("test.xlsx").Sheets("Sheet2") 'changes workbook to get the find/replace data

and

Set Wks = ActiveWorkbook.Worksheets(1)

for the loop i've used this

Public Function IsFileOpen(strFileName As String) As Boolean
    
    On Error Resume Next 'Ignore any errors (i.e. if workbook is not open)
    
        Set wrkFileName = Workbooks(strFileName)
        
            If wrkFileName Is Nothing Then
                IsFileOpen = False
            Else
                IsFileOpen = True
            End If
            
    On Error GoTo 0 'Nullify above error handler
    
End Function
Sub Macro1()

    Dim strDir As String, _
        strFileType As String
    Dim objFSO As Object, _
        objFolder As Object, _
        objFile As Object
    Dim intCounter As Integer
        
    strDir = ActiveWorkbook.Path & "\folder\" 'Change to suit
    strFileType = "xlsx" 'change to suit if required
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strDir)
    
    Application.ScreenUpdating = False
        
    For Each objFile In objFolder.Files
        'If the file in the 'strDir' directory is not this workbook, then...
        If objFile.Name <> ThisWorkbook.Name Then
            If objFile.Name Like "*." & strFileType Then
                '...check to see if it's open.  If it is...
                If IsFileOpen(objFile.Name) = True Then
                    '...run the 'MyMacro' passing the active workbook variable with it and _
                    increment the counter.
                     Call MyMacro(objFile.Name)
                     intCounter = intCounter + 1
                'Else, _
                1. Open the file, _
                2. Run the 'MyMacro' passing the active workbook variable with it, _
                3. Save the changes and close the file, and _
                4. Increment the counter.
                Else
                     Workbooks.Open (strDir & "\" & objFile.Name), UpdateLinks:=False
                     Call MyMacro(objFile.Name)
                     Workbooks(objFile.Name).Close SaveChanges:=True
                     intCounter = intCounter + 1
                End If
            End If
        End If
        'Release memory
        Set objFSO = Nothing
        Set objFolder = Nothing
        Set objFile = Nothing
    Next objFile
    
    Application.ScreenUpdating = True
    
    Select Case intCounter
        Case Is = 0
            MsgBox "There were no """ & strFileType & """ file types in the """ & strDir & """ directory for the desired macro to be run on.", vbExclamation, "Data Execution Editor"
        Case Is = 1
            MsgBox "The desired macro has been run on the only """ & strFileType & """ file in the """ & strDir & """ directory.", vbInformation, "Data Execution Editor"
        Case Is > 1
            MsgBox "The desired macro has now been run on the " & intCounter & " files in the """ & strDir & """ directory.", vbInformation, "Data Execution Editor"
    End Select
    
End Sub
Sub MyMacro(strDesiredWkb As String)

   MultiReplace
    MsgBox strDesiredWkb

End Sub

the spreadsheet should be in a folder and the files you want run the macro on should be in a new folder (inside that folder)

and now i'm able to run the find/replace macro on all my files :>