Sub CreationSynthese() ' Initialisation
' --------------
Cells.Delete
'MsgBox ThisWorkbook.Path
Range("A1") = "Date de soumission"
Range("B1") = "Equipe"
Range("C1") = "CEA"
Range("D1") = "Objet de la soumission"
Range("E1") = "Référence GES / Contrat"
Range("F1") = "Processus"
Range("G1") = "Réponse de la cellule qualité"
Range("H1") = "Date de réponse"
JaunePale = 13434879
Range("A1:H1").Interior.Color = JaunePale
Range("A1:H1").Font.Bold = True
' Parcours de tous les fichiers
' -----------------------------
ChDir "W:\rep"
ClasseurRegional = Dir("W:\rep\*.xlsm")
While Len(ClasseurRegional) > 0
Workbooks.Open ClasseurRegional
Application.DisplayAlerts = False
avantderniereligne = ActiveSheet.UsedRange.Rows.Count - 1
Sheets("BD").Select
Range("B2:I" & avantderniereligne + 1).Copy
Workbooks("recap.xlsm").Activate
DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
ActiveSheet.Paste
'Range("A" & DebutNomFichier & ":A" & ActiveSheet.UsedRange.Rows.Count) = ClasseurRegional
Workbooks(ClasseurRegional).Close
ClasseurRegional = Dir
Wend
' Fin des travaux
' ---------------
LigneTotal = ActiveSheet.UsedRange.Rows.Count + 1
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub