[VBA] - Récupération données de plusieurs fichiers
Bonjour Mesdames, Messieurs,
Je souhaite faire de la récupération de données, de plusieurs classeurs Excel, pour les concaténer dans un seul.
Les données se renseignent dans les champs correspondant.
Malheureusement, après avoir lu beaucoup de post sur le sujet, je n'arrive pas à me dépatouiller.
Voici le bout de code que j'ai actuellement :
Sub Recuperation()
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim ADOCommand As ADODB.Command
Dim Fichier As String, Feuille As String
Dim Cellule As String
'Adresses des plages de cellule contenant les données à récupérer
Prod1 = "D28:H28"
Prod2 = "K28:M28"
HProd1 = "T28:X28"
HProd2 = "AA28:AC28"
Spam = "P28:R28"
Graphique = "AF29:AM29"
'Nom de la feuille : identique pour chaque fichier
Feuille = "F_Calc$"
'Chemin complet du classeur fermé
Fichier = "X:\Reporting\2018\01\Client_ Rapport du 2018_01_01.xlsm"
'Connexion au classeur
Set Source = New ADODB.Connection
Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & Fichier & ";Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=2;"""
'Récupération des données du classeur, dans la feuille F_Calc
Set ADOCommand = New ADODB.Command
With ADOCommand
.ActiveConnection = Source
Set Rst = New ADODB.Recordset
.CommandText = "SELECT * FROM [" & Feuille & Prod1 & "]"
End With
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
'Collage des données à l'endroit nécessaire dans mon autre classeur
Set Rst = Source.Execute("[" & Feuille & Prod1 & "]")
Range("C8").CopyFromRecordset Rst
Set Rst = Source.Execute("[" & Feuille & Prod2 & "]")
Range("H8").CopyFromRecordset Rst
Set Rst = Source.Execute("[" & Feuille & HProd1 & "]")
Range("L8").CopyFromRecordset Rst
Set Rst = Source.Execute("[" & Feuille & HProd2 & "]")
Range("Q8").CopyFromRecordset Rst
Set Rst = Source.Execute("[" & Feuille & Spam & "]")
Range("U8").CopyFromRecordset Rst
Set Rst = Source.Execute("[" & Feuille & Graphique & "]")
Range("Y8").CopyFromRecordset Rst
'fermeture de la connexion
Rst.Close
Source.Close
Set Source = Nothing
Set Rst = Nothing
Set ADOCommand = Nothing
End Sub
Je suis bloqué sur la partie de récupération multi fichier, en gros, je voudrais une boucle pour que cette macro prennent les fichiers :
- "X:\Reporting\2018\01\Client_ Rapport du 2018_01_01.xlsm"
"X:\Reporting\2018\01\Client_ Rapport du 2018_01_02.xlsm"
"X:\Reporting\2018\01\Client_ Rapport du 2018_01_03.xlsm"
etc...
A chaque fois que l'on traite un nouveau fichier, il faut décaler les Range en (C9, C10 etc...) - Je n'ai pas encore traité cette partie, donc ne vous y attardez pas trop =). (avec l'option Offset je pense)
Set Rst = Source.Execute("[" & Feuille & Prod1 & "]")
Range("C8").CopyFromRecordset Rst
Set Rst = Source.Execute("[" & Feuille & Prod2 & "]")
Range("H8").CopyFromRecordset Rst
Set Rst = Source.Execute("[" & Feuille & HProd1 & "]")
Range("L8").CopyFromRecordset Rst
Set Rst = Source.Execute("[" & Feuille & HProd2 & "]")
Range("Q8").CopyFromRecordset Rst
Set Rst = Source.Execute("[" & Feuille & Spam & "]")
Range("U8").CopyFromRecordset Rst
Set Rst = Source.Execute("[" & Feuille & Graphique & "]")
Range("Y8").CopyFromRecordset Rst
J'espère avoir été assez clair.
Merci.
Bonne journée à tous.
Re-Bonjour,
Bon, j'ai résolu ma première interrogation (récupération multi fichier)
Dim nomFichier
nomFichier = chemin & Dir(chemin & "*.xls*")
Do While Len(nomFichier) > 0
Loop
Cependant, dans ma dernière partie, je bloque pour décaler d'une ligne mes Range
Cellule1 = "C8"
Set Rst = Source.Execute("[" & Feuille & Prod1 & "]")
Range(Cellule1).CopyFromRecordset Rst
A la suite du Range, je voudrais faire passer la Cellule en D8, mais la fonction .Offset ne change rien, avez-vous une idée ?
Merci.
bonne soirée.
Problème résolu.... merci de votre aide...