Dim ClasseurMaitre
Sub ConsolideArborescence()
Application.ScreenUpdating = False
[A9:L1000].ClearContents
ClasseurMaitre = ThisWorkbook.Name
repertoire = ThisWorkbook.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Set DossierRacine = fs.getfolder(repertoire)
Lit_dossier DossierRacine, 1
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
For Each d In dossier.SubFolders
Lit_dossier d, niveau + 1
Next
For Each f In dossier.Files
nf = f.Name
If nf <> ClasseurMaitre Then
Workbooks.Open Filename:=dossier & "\" & nf
[A9:L20].Copy Workbooks(ClasseurMaitre).Sheets(1).[A65000].End(xlUp).Offset(1, 0)
ActiveWorkbook.Close False
End If
Next
End Sub