XL 2016 boucle de recherche

Sub Boucle1Fichiers()
    Dim Chemin As String, Fichier As String, i As Integer
    
    ' Efface liste
    Range("C10:C900").ClearContents
    
    'Définit le répertoire contenant les fichiers, à modifier. ici fichiers sur écran.
    Chemin = [A10]
    
    'Boucle sur tous les fichiers du répertoire.
    Fichier = Dir(Chemin & "*.*")
    i = 10
    
    Do While Len(Fichier) > 0
        ' Range le nom du fichier dans la colonne A
        Cells(i, 3) = Fichier
        i = i + 1 ' incrément N° de ligne
        Fichier = Dir()
    Loop
End Sub

Sub Boucle1Fichiers()
    Dim Fichier As String
    Dim CelluleChemin As Range
    Dim i As Integer
    '
    Const NbChemins = 3
    Const CelluleChemin1 = "A10"
    
    ' Efface liste
    ActiveSheet.Range(CelluleChemin1).Offset(, 2).Resize(NbChemins).ClearContents
    
    For i = 1 To NbChemins
        'Définit la cellule du répertoire contenant les fichiers, à modifier. ici fichiers sur écran.
        Set CelluleChemin = ActiveSheet.Range(CelluleChemin1).Offset(i - 1)
    
        'Boucle sur tous les fichiers du répertoire.
        Fichier = Dir(CelluleChemin.Value & "*.*")
        
        Do While Len(Fichier) > 0
            ' Range le nom du fichier dans la colonne C
            If Len(CelluleChemin.Offset(, 2).Value) > 0 Then CelluleChemin.Offset(, 2).Value = CelluleChemin.Offset(, 2).Value & vbLf
            CelluleChemin.Offset(, 2).Value = CelluleChemin.Offset(, 2).Value & Fichier
            Fichier = Dir()
        Loop
    Next i
    
    ActiveSheet.Range(CelluleChemin1).Offset(, 2).Resize(NbChemins).EntireRow.AutoFit
End Sub

Option Explicit
Sub Test()
   BoucleFichiers ActiveSheet.[A10:A12]
   BoucleFichiers ActiveSheet.[C10:C12]
   BoucleFichiers ActiveSheet.[E10:E12]
   End Sub
Sub BoucleFichiers(ByVal RDoss As Range)
   Dim TDoss(), TRésu(), L As Long, TJn() As String, NomFic As String, N As Long
   If RDoss.Rows.Count = 1 Then
      ReDim TDoss(1 To 1, 1 To 1): TDoss(1, 1) = RDoss.Value
   Else
      TDoss = RDoss.Value: End If
   ReDim TRésu(1 To UBound(TDoss, 1), 1 To 1)
   For L = 1 To UBound(TDoss, 1)
      ReDim TJn(0 To 49): N = -1
      NomFic = Dir(TDoss(L, 1) & "*.*")
      Do While NomFic <> ""
         N = N + 1: TJn(N) = NomFic
         NomFic = Dir
         Loop
      If N >= 0 Then
         ReDim Preserve TJn(0 To N)
         TRésu(L, 1) = Join(TJn, vbLf)
         End If
      Next L
   RDoss.Offset(, 1).Value = TRésu
   End Sub