Parcours de plusieurs fichiers

'Procédure de boucle sur tous les fichiers du répertoire
'et de ces sous-répertoires
'Passer en paramètres de cette sub :
    'ByVal Nom As String :
    'Nom = le "tag" (mot commun) qui te permet d'identifier tes noms de fichiers
    'ByRef dossier :
    'Dossier = ton répertoire !!!! PAS AU FORMAT STRING !!!! en cas de difficulté, utiliser :
        'Sub arborescenceRepertoire()
        'et
        'Function ChoixDossier()
'sources
'http://www.excel-downloads.com/forum/126930-vba-liste-dossiers-et-sous-dossiers-dun-dosssier.html
Sub Lit_dossier(ByVal Nom As String, ByRef dossier)
Dim f, d

   For Each f In dossier.Files
'Si le nom du fichier contient le contenu de la variable Nom    [If f.Name Like Nom]
'Et qu'il s'agit bien d'un fichier Excel                        [And Left(Split(f.Name, ".")(1), 3) = "xls"]
'alors on lance la procédure VaChercherInfos                    [VaChercherInfos dossier.Path, f.Name]
        If f.Name Like Nom And Left(Split(f.Name, ".")(1), 3) = "xls" Then VaChercherInfos dossier.Path, f.Name
   Next
'Boucle récursive pour les sous-répertoires éventuels
   For Each d In dossier.SubFolders
     Lit_dossier Nom, d
   Next
End Sub

Sub VaChercherInfos(ByVal Chemin As String, Fichier As String)
Dim Feuille As Worksheet, WbkRecap As Workbook, WbkSource As Workbook

Application.ScreenUpdating = False
Set WbkRecap = ThisWorkbook
Set WbkSource = Workbooks(Chemin & "\" & Fichier)
'Dans le classeur "récap" (celui-ci), dans la feuille "Feuil1"
With WbkRecap.Sheets("Feuil1")
    'dans la colonne A, en dernière ligne, on inscrit les chemin et nom du fichier source
    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Chemin & "\" & Fichier
    'en dessous, on inscrit la date d'extraction (date du jour)
    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = CDate(Date)
End With
Workbooks.Open WbkSource
With WbkSource
    '----------------------------------------
    '
    ' ICI LA PROCEDURE DE RECHERCHE ET D'EXTRACTION DE DONNEES
    '
    '----------------------------------------
    Application.DisplayAlerts = False
    .Close
    Application.DisplayAlerts = True
End With
Application.ScreenUpdating = True
End Sub

Sub arborescenceRepertoire()
'sources
'http://www.excel-downloads.com/forum/126930-vba-liste-dossiers-et-sous-dossiers-dun-dosssier.html
Dim racine As String, fs As Object, dossier_racine, Nom As String

'!!!!!!! déterminer tout de suite le "tag" à utiliser
        'pour les noms de fichiers :
Nom = "TAG"
  racine = ChoixDossier()
  If racine = "" Then Exit Sub
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.getfolder(racine)
  Lit_dossier Nom, dossier_racine
End Sub

Function ChoixDossier()
If Val(Application.Version) >= 10 Then
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
            ChoixDossier = .SelectedItems(1)
        Else
            ChoixDossier = ""
        End If
    End With
Else
    ChoixDossier = InputBox("Répertoire?")
End If
End Function