Ouverture de fichiers Excel dans des sous-dossiers (niveau 1)

Bonjour,

J'ai fait pas mal de recherche sur les forums mais je n'ai pas trouvé la solution.

Je dois consolider des données de fichiers Excel 2007 répartis dans 9 sous-dossiers (01 jusqu'à 09, les adresses sont connues, sur un réseau interne) d'un dossier parent ("fiches de suivi").

Je souhaite uniquement ouvrir les fichiers dans les sous-dossiers de niveau 1 (ex. 01) car dans les sous-dossiers, des anciennes versions sont conservées dans un dossier "Old" qui ne m'intéressent pas.

Voila le code que j'ai pour le moment :

Sub Consolidation()

Dim intFile As Integer
Dim strWB As String
Dim strFile As String
Dim lgDerLig As Long

lgDerLig = 6

Application.ScreenUpdating = False
Application.EnableEvents = False


' Nom du classeur actuel
strWB = ThisWorkbook.Name

' Récupération du premier fichier dans le répertoire
repertoire = "C:\Users\...\01 Fiches de suivi"
strFile = Dir(repertoire & "\*.xls")

' Boucle du 1er au dernier classeur dans le répertoire
Do While strFile <> ""
' Ouvrir le fichier
chemin = repertoire & "\" & strFile
Workbooks.Open (chemin)

' Sélectionner le 1er onglet
ActiveWorkbook.Worksheets(1).Activate

' cellules à copier
Worksheets("Identification du gain").Range("X3").Copy
Workbooks(strWB).Worksheets("Consolidation").Range("A" & lgDerLig).PasteSpecial xlPasteValues

lgDerLig = lgDerLig + 1

' Fermeture du classeur
Workbooks(strFile).Close

' Classeur suivant
strFile = Dir
Loop

MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub


Je pourrais dupliquer le code pour les 9 sous-dossiers mais je suis sûr qu'il y a une manière plus simple de coder cela.

Merci d'avance pour vos réponses

James