VBA cherche le fichier Excel dans un dossier

Sub Lancer()
  Dim Cel As Range, sPath As String
  Dim ListFic As New Collection, Nb As Integer
  ' Dossier de départ
  sPath = ThisWorkbook.Path & "\RESEAUX\"
  ' Piur chaque cellule remplie de la colonne a
  For Each Cel In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    If Cel <> "" Then
      ChercheFichier sPath, Cel.Value, ListFic
      For Nb = 1 To ListFic.Count
        Cells(Cel.Row, 1 + Nb).Value = ListFic(Nb)
      Next Nb
      ' Vider la colection
      Set ListFic = New Collection
    End If
  Next Cel
End Sub


Sub ChercheFichier(dossierDépart, nomFichier, Retour As Collection)
'renvoie dans la variable "retour" le chemin complet de "nomFichier"
'cherché dans "dossierDépart" (antislash final requis)
  Dim fso, Fichiers, Fichier, Dossier, Racine, SousDossiers


  Set fso = CreateObject("Scripting.FileSystemObject")
  Set Racine = fso.GetFolder(dossierDépart)
  Set Fichiers = Racine.Files
  For Each Fichier In Fichiers
    If UCase(Fichier.Name) Like UCase(nomFichier & ".*") Then
      On Error Resume Next
      Retour.Add Fichier.Path, Fichier.Path
      On Error GoTo 0
    End If
  Next
  ' Récursivité
  Set SousDossiers = Racine.SubFolders
  For Each Dossier In SousDossiers
    ChercheFichier Dossier, nomFichier, Retour
  Next
End Sub