Coralie01120
XLDnaute Occasionnel
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
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
