Microsoft 365 Macro pour récupérer des données dans plusieurs fichiers identiques

[Coralie01120]

Bonjour,

Je cherche à récupérer via une macro des données dans plusieurs fichiers (identiques dans le même répertoire) afin de me faire une BDD en gagnant du temps.
J'ai plus d'une centaine de fichiers. Je vous en joins 2 pour l'exemple (classeur1 et classeur2).
Les fichiers sont tous répertoriés sous Z:\COLLABORATEURS\Coralie\TEST

Ainsi, les données à récupérer sont toujours : B1 = client, B8 la commande et D8 la date.
Mon objectif est de faire ma BDD dans l'onglet BDD du fichier macro comme ceci : en colonne A le client, en colonne B la commande et en colonne C la date.

J'ai déjà commencé à faire ma macro mais elle ne fonctionne pas...

La voici :

Sub listerLesFichiers()

Application.ScreenUpdating = False

Dim chemin As String, Fichier As String

chemin = "Z:\COLLABORATEURS\Coralie\TEST\"
Fichier = Dir(chemin & "*" & ".xlsx", vbNormal)

Do While Fichier <> ""

With Workbooks.Open(chemin & Fichier)
.Activate

DerLigneVide = Workbooks("macro.xlsm").Sheets("BDD").Range("A" & Rows.Count).End(xlUp).Row + 1
Workbooks("macro.xlsm").Sheets("BDD").Cells(DerLigneVide, 1) = ActiveWorkbook.Sheets("Feuil1").Range("B1")


DerLigneVide = Workbooks("macro.xlsm").Sheets("BDD").Range("B" & Rows.Count).End(xlUp).Row + 1
Workbooks("macro.xlsm").Sheets("BDD").Cells(DerLigneVide, 2) = ActiveWorkbook.Sheets("Feuil1").Range("B8")

DerLigneVide = Workbooks("macro.xlsm").Sheets("BDD").Range("C" & Rows.Count).End(xlUp).Row + 1
Workbooks("macro.xlsm").Sheets("BDD").Cells(DerLigneVide, 3) = ActiveWorkbook.Sheets("Feuil1").Range("D8")

End With

Fichier = Dir
Loop

Call FermerTousClasseurs

Application.ScreenUpdating = True

End Sub

Sub FermerTousClasseurs()

Application.DisplayAlerts = False

Dim Classeur As Workbook
For Each Classeur In Workbooks
If Classeur.Name <> ThisWorkbook.Name Then
Classeur.Close SaveChanges:=False
End If
Next Classeur

Application.DisplayAlerts = True

Je vous joins les fichiers pour que cela soit plus clair.

Merci pour votre aide et très bonne soirée,

End Sub

 

[merinos]

Bonjour,
pourquoi ne pas utiliser PowerQuery ?
cf : https://www.excel-downloads.com/threads/conversion-dun-tableau-en-liste.20054402/#post-20407908

Bonjour Laurent,

Visiblement tu n'as pas été entendu.
pourtant cette methode est infiniment plus efficasse.

j'ai déja donné une methode pour le faire Ma methode.