Microsoft 365 aller chercher une cellule dans plusieurs fichier

Sub Liaisons()
Dim chemin$, ext$, feuille$, cel$, tablo, i&
chemin = ThisWorkbook.Path & "\" 'à adapter
ext = ".xlsx" 'à adapter
feuille = "Produit 1" 'à adapter
cel = "B1" 'à adapter
With [A1].CurrentRegion
    tablo = .Resize(, 2) 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        If Dir(chemin & tablo(i, 1) & ext) <> "" Then _
            tablo(i, 2) = "='" & chemin & "[" & tablo(i, 1) & ext & "]" & feuille & "'!" & cel Else tablo(i, 2) = ""
    Next
    .Value = tablo 'restitution
End With
End Sub

Sub Liaisons()
Dim dossier$, feuille$, cel$, fso As Object, sf As Object, chemin$, f As Object, n%, tablo()
dossier = ThisWorkbook.Path 'à adapter
feuille = "Produit 1" 'à adapter
cel = "B1" 'à adapter
Set fso = CreateObject("Scripting.FileSystemObject")
For Each sf In fso.getfolder(dossier).subfolders
    chemin = sf.Path & "\"
    For Each f In sf.Files
        n = n + 1
        ReDim Preserve tablo(1 To 2, 1 To n)
        tablo(1, n) = f.Name
        tablo(2, n) = "='" & chemin & "[" & tablo(1, n) & "]" & feuille & "'!" & cel
Next f, sf
'---restitution---
With Feuil1 'CodeName à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A2] '1ère cellule de destination, à adapter
        If n Then .Resize(n, 2) = Application.Transpose(tablo) 'Transpose est limitée à 65536 lignes
        .Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ en dessous
    End With
    With .UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub