Sub TraitementFichiers()
Dim dossier$, nomdosexclu$, nomdos$, n&, liste$()
Dim F As Worksheet, lig&, nomfich$, x$, y$, v1, v2, v3
dossier = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\"))
nomdosexclu = Mid(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") + 1)
'---liste des sous-dossiers---
nomdos = Dir(dossier, vbDirectory) '1er dossier
While nomdos <> ""
If nomdos <> "." And nomdos <> ".." And nomdos <> nomdosexclu Then
n = n + 1
ReDim Preserve liste(1 To n)
liste(n) = nomdos
End If
nomdos = Dir 'dossier suivant
Wend
'---traitement des fichiers---
Set F = ActiveSheet 'feuille de restitution, à adapter
lig = 2
If n Then
For n = 1 To UBound(liste)
nomfich = Dir(dossier & liste(n) & "\*.xls*") '1er fichier
While nomfich <> ""
x = "'" & dossier & liste(n) & "\[" & nomfich & "]MaFeuille'!"
y = liste(n) & "\" & nomfich
v1 = ExecuteExcel4Macro(x & "R2C1") 'A2
v2 = ExecuteExcel4Macro(x & "R2C2") 'B2
v3 = ExecuteExcel4Macro(x & "R2C3") 'C2
F.Hyperlinks.Add F.Cells(lig, 1), dossier & y, TextToDisplay:=y
F.Cells(lig, 2) = v1
F.Cells(lig, 3) = v2
F.Cells(lig, 4) = v3
lig = lig + 1
nomfich = Dir 'fichier suivant du dossier
Wend
Next
End If
F.Rows(lig & ":" & F.Rows.Count).Delete
End Sub