Dim ClasseurMaitre
Sub ConsolideArborescence()
Application.ScreenUpdating = False
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
[A2].Copy Workbooks(ClasseurMaitre).Sheets(1).[C3].End(xlUp).Offset(1, 0)
[B2].Copy Workbooks(ClasseurMaitre).Sheets(1).[G3].End(xlUp).Offset(1, 0)
[C2].Copy Workbooks(ClasseurMaitre).Sheets(1).[K3].End(xlUp).Offset(1, 0)
ActiveWorkbook.Close False
End If
Next
End Sub