Microsoft 365 aller chercher une cellule dans plusieurs fichier

pocketace

XLDnaute Nouveau
Bonjour,

Je dois aller chercher dans plusieurs fichier dont je connait le nom une cellule par exemple B1.

Si je tape la formule ='[L015573.xlsx]Produit 1'!$B$1, ça va me chercher la valeur de la bonne cellule.

Mais j'ai une liste assez longue et j'aimerai pouvoir modifier seulement le nom du fichier dans la formule.

Mes exemple de noms de fichier : L015673, L015773, L015873 etc.. et j'en ai 200 à faire.

Je pense qu'il existe un truc automatique mais les [ ] me bloque.

Quelqu'un a une idée.

Merci d'avance.
David
 

pocketace

XLDnaute Nouveau
Bonjour M12,

Alors,

- les fichiers sont répartis dans 25 sous dossiers (mais je peux m'en accomodé)
- peut importe (soit je prend tout soit je peu faire une liste positive)
- oui tous les fichiers on la même architecture avec le même nom de feuille (que des enregistrer sous).
 

job75

XLDnaute Barbatruc
Bonjour pocketace, M12, le forum,

Le plus simple est de créer une formule de liaison avec chacun des fichiers :
VB:
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
Téléchargez les fichiers joints dans le même dossier (le bureau) et cliquez sur le bouton.

Bonne journée.
 

Pièces jointes

  • Liaisons(1).xlsm
    17.5 KB · Affichages: 10
  • L015673.xlsx
    8.4 KB · Affichages: 3
  • L015773.xlsx
    8.5 KB · Affichages: 4
  • L015873.xlsx
    8.4 KB · Affichages: 3

job75

XLDnaute Barbatruc
Cela dit il n'est pas nécessaire de connaître les noms des fichiers à étudier.

Il suffit de savoir où il se trouvent : ici dans les 25 sous-dossiers, donc utilisez :
VB:
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
Téléchargez le dossier zippé joint, les fichiers .xlsx sont dans les sous-dossiers.
 

Pièces jointes

  • Dossier.zip
    35.2 KB · Affichages: 6

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 015
Membres
101 870
dernier inscrit
Dethomas