Copier une partie d'un classeur excel dans 40 dossiers différent

Option Explicit

'*** Macro qui lance le traitement:
'*** 1 - Création des objets : Workbook, Worksheet et Range (qui contient la plage à copier)
'*** 2 - Appel de la procédure RecupFichiersXL(Arg())
'*** 3 - Boucle sur tous les éléments du tableau mTab()
'***     ° Ouvre le fichier Excel à mettre à jour
'***     ° Création des objets : Workbook, Worksheet
'***     ° Copie de la plage
'***     ° Sauvegarde et ferme le fichier
'***     ° Ferme les objets et passe à l'élément suivant du tableau
''
Public Sub MaMacro()
Dim mTab()
Dim wkOut As Workbook
Dim ws As Worksheet
Dim wsOut As Worksheet
Dim plage As Range
Dim i As Long

    ' Désactive les messages d'alerte
    Application.DisplayAlerts = False
    
    ' Instanciation de l'objet Worksheet (Feuille qui contient les données à copier)
    Set ws = ThisWorkbook.Worksheets("Feuil1")  ' /!\ A adapter
    
    ' Instanciation de l'objet Range (Plage des cellules à copier)
    Set plage = ws.Range("A2:C20") ' /!\ A adapter
    
    'appel de la procédure qui remplit le tableau
    Call RecupFichiersXL(mTab())
    
    ' i = indice du tableau
    For i = LBound(mTab()) To UBound(mTab())
        ' Instanciation de l'objet Workbook (Fichier de derstination pour la copie)
        Set wkOut = Workbooks.Open(mTab(i))
        ' Instanciation de l'objet Worksheet (Feuille destination)
        Set wsOut = wkOut.Worksheets("Feuil1")  ' /!\ A adapter
        ' Copie de la plage
        plage.Copy Destination:=wsOut.Range("A2")  ' /!\ A adapter
        ' Sauvegarde du fichier
        wkOut.Save
        ' Fermeture du fichier
        wkOut.Close
        ' Libération des objets et de la mémoire
        Set wsOut = Nothing
        Set wkOut = Nothing
        ' On passe à l'élément suivant du tableau
    Next i
    
    ' Active les messages d'alerte
    Application.DisplayAlerts = True
    'Libération de l'objet et de la mémoire
    Set ws = Nothing

    MsgBox "Traitement terminé !!!"

End Sub

'*** Procédure qui parcourt un répertoire
'*** Elle recoit en paramètre un tableau
'*** Elle remplit le tableau passé en référence
'*** avec le chemin complet d'accès des fichiers xlsx
''
Private Sub RecupFichiersXL(ByRef mTab())
    Dim Chemin As String
    Dim Fichier As String
    Dim i As Long
 
    'Définit le répertoire contenant les fichiers
    '/!\ adapter le chemin complet du répertoire
    Chemin = "D:\CCM\"
 
    'Boucle sur tous les fichiers xlsx du répertoire.
    Fichier = Dir(Chemin & "*.xlsx")
    Do While Len(Fichier) > 0
        ReDim Preserve mTab(i)
        mTab(i) = Chemin & Fichier
        i = i + 1
        Fichier = Dir()
    Loop
End Sub