Appliquer macro à plusieurs fichiers d'un répertoire

Bonjour le forum,

J'aurai besoin d'aide pour adapter la macro suivante :

Option Explicit
Public critere%

Sub dispatcher()
Dim Tbl As Variant, data As Variant, i%
Dim dico1 As Object, cle1 As Variant, result1 As Variant
Dim wb As Excel.Workbook
Dim MonRepertoire, Repertoire As FileDialog, racine As String
Dim colonne$

    'colonne = Application.InputBox("Entrez la colonne servant de critère de dispatching : ", "Saisie en texte (i.e : A B ...)", Type:=2)
    'critere = ActiveSheet.Columns(colonne).Column
    UserForm1.Show
    If critere = 0 Then Exit Sub

    racine = Split(ThisWorkbook.Name, ".")(0)

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MonRepertoire = Repertoire.SelectedItems(1)

    data = Cells(Rows.Count, 1).End(xlUp).CurrentRegion

    Set dico1 = CreateObject("Scripting.Dictionary")
    For i = LBound(data) + 1 To UBound(data) ' hors en-tête
        dico1(data(i, critere)) = ""
    Next

    Application.ScreenUpdating = False
    For Each cle1 In dico1.Keys
        result1 = filtreArray(data, critere, cle1)
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Model.xlsx")
        wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(result1, 1), UBound(result1, 2)) = result1
        wb.SaveAs (MonRepertoire & "\" & "_" & cle1 & ".xlsx")
        wb.Close
        Set wb = Nothing
    Next
    Application.ScreenUpdating = True

    MsgBox "Terminé, fichiers sauvegardés sous """ & MonRepertoire & "\" & """ !"
End Sub

Il faudrait que celle-ci s'applique à plusieurs fichiers EXCEL contenus dans un répertoire.

Est-ce possible ?

Un grand merci d'avance pour votre aide.

Bonjour Sam,

Je ne comprends pas la demande
Le code doit s'appliquer à plusieurs fichiers, mais il s'agit là d'une création de fichiers en fonction du contenu de cellules !?

A+

Oui je me suis rendu compte qu'il y avait un bug dans ma demande.

J'ai ouverts un autre sujet pour tenter de réaliser ce que je souhaite.

Merci.