Sub Test()
    maliste = liste_mes_Fichiers("C:\Résultats\")  ' EXTENTION DEMANDE
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        For l = LBound(maliste) To UBound(maliste)
            If maliste(l) Like "*" & Cells(i, "A").Text & ".*" Then Cells(i, "B").Value = maliste(l)
        Next
    Next
End Sub
Function liste_mes_Fichiers(path As String, Optional T As Variant = Null, Optional ExT As Variant = 0, Optional a As Long = 0)
    Dim itemVU As String, folder As Variant, dirCollection As Collection, i As Long
    Set dirCollection = New Collection
    If IsNull(T) Then T = Array()
    crit = vbDirectory Or vbHidden Or vbNormal Or vbArchive Or vbReadOnly Or vbSystem Or vbVolume
    On Error GoTo passe
    itemVU = Dir(path, crit)
      Do Until itemVU = vbNullString
        If Left(itemVU, 1) <> "." And Not path Like "*RECYCLE*" Then
            If (GetAttr(path & itemVU) And vbDirectory) <> vbDirectory Then
                 If IsArray(ExT) Then
                    For i = 0 To UBound(ExT)
                        If itemVU Like "*" & ExT(i) Then
                            ReDim Preserve T(0 To a): T(a) = path & itemVU: a = a + 1:
                        End If
                    Next
                Else
                    ReDim Preserve T(0 To a): T(a) = path & itemVU: a = a + 1:
                End If
            End If
        End If
        'ajout des dossiers enfant direct de la racine a la collection
        If Left(itemVU, 1) <> "." And (GetAttr(path & itemVU) And vbDirectory) = vbDirectory Then
            dirCollection.Add itemVU
        End If
        itemVU = Dir()
    Loop
passe:
    Err.Clear
    'Exploration des subdossier inscrit dans la collection
    For Each folder In dirCollection
          liste_mes_Fichiers path & folder & "\", T, ExT, a
    Next folder
    liste_mes_Fichiers = T
End Function