Remplir une feuille avec d'autres classeurs

Bonjour le forum !

Alors je m'explique. Je cherche à remplir une feuille excel grâce a d'autres données contenues dans des dossiers séparés.

Mon premier dossier s'appelle "Besoins" et il contient plusieurs sous dossiers par secteurs.

Par exemple : Fournisseur, Compta, Qualité, Recherche, etc.

Ce que je veux c'est centralisé tout ces fichiers dans un seul classeur excel. Et donc avoir la liste des IDs de chaques personnes pour chaque secteurs.

En cliquant sur un bouton, ça déclenche la fonction suivante :

Sub Remplir(ByVal chemin As String)
'--------Déclaration
Dim Dossier As Object
Dim i As Integer
Dim bSousDossier As Boolean
Dim FSO As Object
Dim fichier As String
Dim Secteur As String
Dim Xlapp    As Excel.Application
Dim XlBook   As Excel.Workbook 'ton nouveau classeur
Dim XlSheet  As Excel.Worksheet 'feuille du classeur sur laquelle tu agis

'-------- Begin
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = FSO.GetFolder(chemin)
Set Xlapp = CreateObject("Excel.Application")
Application.ScreenUpdating = False

'A true pour traiter les sous dossiers
bSousDossier = True
'On set i a 2 pour pas écraser les entêtes
i = Range("A" & Rows.Count).End(xlUp).Row
'On test si il y a un \ à la fin
If Right(chemin, 1) <> "\" Then
    chemin = chemin & "\"
End If

'On veut que les fichiers excels qui commencent par 13 (donc ID)
fichier = Dir(chemin & "13*.xlsx")
Secteur = RetournerSecteur(chemin)
Do While fichier <> ""
    i = i + 1
    Sheets("Besoins").Range("B" & i) = RetournerCentre(fichier) 'Va retourner l'ID
    Sheets("Besoins").Range("A" & i) = Secteur 'Va retourner les 4 premières lettres du secteur
    fichier = Dir()
Loop
If bSousDossier Then
    For Each Dossier In Dossier.SubFolders
        Remplir Dossier.Path
    Next Dossier
End If

Application.ScreenUpdating = True
End Sub

Sauf que voilà, quand je fais le traitement en mode pas à pas, toutes mes données s'affichent correctement et toutes les données sont présentes. Mais quand je le fais directement complètement, Les données ne sont plus dans le même ordre, il me manque certains fichiers.

Auriez-vous une idée de quoi ça peut bien venir ?

Salutations

Zohnya

Bon. Du coup mon problème venait de ma fonction récursive totalement pourrie.

Je me suis un peu plus penchée sur le fonctionnement de FSO pour enfin arriver ce résultat, qui marche parfaitement bien (et qui est vachement moins moche. ça m'apprendra a bêtement copier des bouts de codes ) :

Sub Remplir(ByVal chemin As String)
'--------Déclaration
Dim Dossier As Object
Dim Files As Object
Dim i As Integer
Dim bSousDossier As Boolean
Dim FSO As Object
Dim fichier As String
Dim Secteur As String

'-------- Begin
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = FSO.GetFolder(chemin)

'Pour désactiver la mise à jour de l'affichage (on réactive à la fin)
Application.ScreenUpdating = False

'On set i au nombre de lignes déjà présentes pour pas écraser les entêtes + données
    i = Range("A" & Rows.Count).End(xlUp).Row

'On veut que les fichiers excels qui commencent par 13 (donc ID)
fichier = Dir(chemin & "13*.xlsx")

For Each Dossier In Dossier.SubFolders
    For Each Files In Dossier.Files
    fichier = Files.Name
    If fichier Like "13" & "*" & ".xlsx" Then
        i = i + 1
       Sheets("Besoins").Range("B" & i) = RetournerCentre(Files.Name) 'Va retourner l'ID
       Sheets("Besoins").Range("A" & i) = RetournerSecteur(Files.Path) 'Va retourner les 4 premières lettres du secteur
  End If
    Next Files
Next Dossier

Application.ScreenUpdating = True
End Sub