XL 2010 [Résolu] Synthèse de plusieurs classeurs VBA

Workbooks.Open ClasseurRegional

Sub Test()
NomFichier = Dir("C:\Users\quentin.schultz\Desktop\VBA Stéphanie RH\*.xlsx") ' NomFichier = le premier fichier trouvé : disons Fribourg.xlsx
While Len(NomFichier) > 0 ' La longueur de Fribourg.xlsx est de 13 caractères, donc 13 > 0...
MsgBox NomFichier ' On affiche : Fribourg.xlsx
NomFichier = Dir ' Hop ! On  lit le fichier suivant ! La variable NomFichier contient maintenant, disons, Genève.xlsx
Wend ' Comme la longueur de Genève.xlsx est > 0, on recommence, et ainsi de suite avec lausanne.xlsx et Neuchâtel.xlsx End Sub
End Sub

Sub Import()

ChDir "C:\Users\quentin.schultz\Desktop\VBA Stéphanie RH"
ClasseurRegional = Dir("C:\Users\quentin.schultz\Desktop\VBA Stéphanie RH\*.xlsx")
While Len(ClasseurRegional) > 0
Workbooks.Open ClasseurRegional
AvantDerniereLigne = ActiveSheet.UsedRange.Rows.Count - 1
Range("A2:B" & AvantDerniereLigne).Copy
Workbooks("Exxtraction.xlsm").Activate
DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
Range("B" & ActiveSheet.UsedRange.Rows.Count + 1).Select
ActiveSheet.Paste
Range("A" & DebutNomFichier & ":A" & ActiveSheet.UsedRange.Rows.Count) = ClasseurRegional
Workbooks(ClasseurRegional).Close
ClasseurRegional = Dir
Wend
End Sub