Private Sub CommandButton1_Click()
Dim Sh&, Cel As Range, Fichier$
'Cache les actions à l'écran
Application.ScreenUpdating = 0
'Fichier prendra pour valeur tout noms de fichier se trouvant dans le répertoire de ce fichier.
Fichier = Dir(ThisWorkbook.Path & "\*.xlsx")
'Tant que Fichier n'est pas vide
Do While Fichier <> ""
'Si fichier n'est pas ce fichier. Si le fichier récap. porte un autre nom, il faut écrire celui-ci en remplaçant Fichier 3
If Fichier <> "Fichier 3.xlsm" Then
'On ouvre le fichier
Workbooks.Open ThisWorkbook.Path & "\" & Fichier
'Pour Sh de 1 jusqu'au nb total de feuille
For Sh = 1 To Sheets.Count
'Pour chaque cellule de la région de A4 de la feuille Sh
For Each Cel In Sheets(Sh).[A4].CurrentRegion
'Si la couleur de Cel est autre que "Aucune"
If Cel.Interior.ColorIndex <> -4142 Then
'On copie la couleur dans la feuille de ce fichier
ThisWorkbook.Sheets(Sh).Range(Cel.Address).Interior.ColorIndex = Cel.Interior.ColorIndex
End If
'Cel suivante
Next
'Feuille suivante
Next
'On ferme le classeur "Fichier"
Workbooks(Fichier).Close
End If
'On passe au suivant
Fichier = Dir
Loop
Application.ScreenUpdating = -1
Beep
End Sub