Extraction de données depuis plusieurs fichier Excel
Bonjour,
Je suis en train d'élaborer une macro mais je bute sur quelques points.
J'aimerais synthétiser des classeurs, tous identiques (à part les valeurs), vers un seul et unique classeur. J'ai réussi déjà plusieurs points (exécution automatique de la macro, création du fichier contenant la synthèse, etc.). Cependant, je peine à extraire les données de plusieurs fichiers.
Pour cela, la macro doit
- Traiter tous les classeurs excel situés dans un dossier précis
- Récupérer pour chaque classeur les valeurs des cellules C13 à C33 de la feuille appelé "Bilan"
- Copier/Coller les cellules vers mon classeur d'arrivé, première feuille, cellule B7 à B 27
- Pour chaque nouveau classeur, décaler d'une colonne vers la droite
J'ai rédigé le code suivant, pour l'instant (je ne mets que la partie sur laquelle je bloque).
Bien sûr, il ne fonctionne pas. Il m'indique que la boucle "For each" ne fonctionne pas car cette boucle ne peut être itéré que sur une collection ou un tableau.
Auriez-vous des pistes pour moi ? Merci bien !
'Partie 3 : Synthese des fichiers sources vers le fichier bilan
Dim CheminClasseursAudits As String, ClasseurAudit As Workbook, NumeroColonne As Integer
'Emplacement des fichiers d'audits
CheminClasseursAudits = ActiveWorkbook.Path & "\Fichiers-à-traiter\"
'Selectionner des fichiers Excel uniquement
ClasseurAudit = Dir("*.xlsx")
'Compteur de colonne
NumeroColonne = 2
'Traitement des classeurs
For Each ClasseurAudit In CheminClasseursAudits
'Insertion du centre
ClasseurBilan.Name = ClasseurAudits.Worksheets(1).Range("NumeroColonne,1")
ClasseurBilan.Worksheets(1).Range("D3") = ClasseurAudits.Worksheets(1).Range("NumeroColonne,2")
'Insertion de la date
ClasseurBilan.Worksheets(1).Range("D4") = ClasseurAudits.Worksheets(1).Range("NumeroColonne,3")
'Insertion des noms
ClasseurBilan.Worksheets(1).Range("B3") = ClasseurAudits.Worksheets(1).Range("NumeroColonne,4")
ClasseurBilan.Worksheets(1).Range("B4") = ClasseurAudits.Worksheets(1).Range("NumeroColonne,5")
'Incrementation du compteur de colonne
ClasseurAudits.Worksheets("Bilan").Range("C13:C33").Copy
ClasseurAudits.Worksheets(1).Range("NumeroColonne,7").Select
ClasseurAudits.Worksheets("Bilan").Range("C13:C33").Paste
NumeroColonne = NumeroColonne + 1
Hoanam,
Si ton pb est toujours d'actualité :
Je te propose de faire ta boucle sur les objets files de FileSystemObject (tu dois référencer "Microsoft Scripting Runtime") :
Le code se présente alors comme :
Dim oWB As Excel.Workbook
Dim oFS As New Scripting.FIleSystemObject
Dim oFolder As Scripting.Folder
Dim oFile As Scripting.File
Dim CheminClasseursAudits As String, ClasseurAudit As Workbook, NumeroColonne As Integer
'Emplacement des fichiers d'audits
CheminClasseursAudits = ActiveWorkbook.Path
'Selectionner des fichiers Excel uniquement
'ClasseurAudit = Dir("*.xlsx")
'Compteur de colonne
NumeroColonne = 2
'Traitement des classeurs
Set oFolder = oFS.GetFolder(CheminClasseursAudits)
'For Each ClasseurAudit In CheminClasseursAudits
For Each oFile In oFolder
Set ClasseurAudit = Application.Workbooks.Open(oFile.Name)
'....
Next
Je n'ai pas regardé le contenu de la boucle plus avant. Mais "=ClasseurAudits.Worksheets(1).Range("NumeroColonne,1")" ne semble pas très orthodoxe.
Relance-moi si besoin.
Oh je l'avais oublié celui-là !
Merci beaucoup pour ton intérêt mais j'ai réglé le problème. Je vais bloquer le sujet ^^
Merci et à bientôt
Bonjour,
Eh bien, 2 ans après j'ai retrouvé le code !
Je me rappelle qu'à l'époque, je n'avais pas réussi à faire un copier/coller.
J'avais opté pour une autre solution : donner à une cellule du classeur d'arrivée la valeur contenue dans la cellule du classeur de départ, puis on passe à la cellule suivante puis on passe au classeur suivant.
Je joins le résultat.
A bientôt
'Partie 3 : Synthese des fichiers sources vers le fichier bilan
Dim CheminClasseurAudit As String, NomClasseurAudit As String
Dim ClasseurAudit As Workbook, NumeroColonne As Integer
Dim NumeroLigneBilan As Integer, NumeroLigneAudit As Integer
'\Fichiers-à-traiter\ est le dossier des classeurs a traiter
'Emplacement des fichiers d'audits
CheminClasseurAudit = ThisWorkbook.Path & "\Fichiers-à-traiter\"
NomClasseurAudit = Dir(CheminClasseurAudit & "*.xls")
'Numéro initial de la 1ère colonne
NumeroColonne = 2
'Traitement des classeurs
Do While NomClasseurAudit <> ""
'Ouvrir le classeur audit
Set ClasseurAudit = Workbooks.Open(CheminClasseurAudit & NomClasseurAudit)
'Insertion nom du classeur
ClasseurBilan.Sheets(1).Cells(1, NumeroColonne) = ClasseurAudit.Name
'Insertion nom du centre
ClasseurBilan.Sheets(1).Cells(2, NumeroColonne) = ClasseurAudit.Sheets(1).Range("D3")
'Insertion de la date
ClasseurBilan.Sheets(1).Cells(3, NumeroColonne).NumberFormat = "m/d/yyyy"
ClasseurBilan.Sheets(1).Cells(3, NumeroColonne) = ClasseurAudit.Sheets(1).Range("D4")
'Insertion des deux noms
ClasseurBilan.Sheets(1).Cells(4, NumeroColonne) = ClasseurAudit.Sheets(1).Range("B3")
ClasseurBilan.Sheets(1).Cells(5, NumeroColonne) = ClasseurAudit.Sheets(1).Range("B4")
'Initialisiation de la premiere cellule a extraire
NumeroLigneBilan = 7
NumeroLigneAudit = 13
'Synthese des resultats compris entre la première cellule des resultats et celle contenant le mot "Moyenne"
While ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 2) <> "Moyenne"
'Extraction de la donnee concernee
ClasseurBilan.Sheets(1).Cells(NumeroLigneBilan, NumeroColonne) = _
ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 3)
'Extraction des titres systematique au cas ou les classeurs n'ont pas tous les memes titres
ClasseurBilan.Sheets(1).Cells(NumeroLigneBilan, 1) = _
ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 2)
'Donnee suivante
NumeroLigneBilan = NumeroLigneBilan + 1
NumeroLigneAudit = NumeroLigneAudit + 1
Wend
'Fermer le classeur d'audit ouvert
ClasseurAudit.Close SaveChanges:=False
'Colonne suivante
NumeroColonne = NumeroColonne + 1
'Classeur suivant
NomClasseurAudit = Dir
Loop
Bonjour,
Eh bien, 2 ans après j'ai retrouvé le code !
Je me rappelle qu'à l'époque, je n'avais pas réussi à faire un copier/coller.
J'avais opté pour une autre solution : donner à une cellule du classeur d'arrivée la valeur contenue dans la cellule du classeur de départ, puis on passe à la cellule suivante puis on passe au classeur suivant.
Je joins le résultat.
A bientôt
'Partie 3 : Synthese des fichiers sources vers le fichier bilan Dim CheminClasseurAudit As String, NomClasseurAudit As String Dim ClasseurAudit As Workbook, NumeroColonne As Integer Dim NumeroLigneBilan As Integer, NumeroLigneAudit As Integer '\Fichiers-à-traiter\ est le dossier des classeurs a traiter 'Emplacement des fichiers d'audits CheminClasseurAudit = ThisWorkbook.Path & "\Fichiers-à-traiter\" NomClasseurAudit = Dir(CheminClasseurAudit & "*.xls") 'Numéro initial de la 1ère colonne NumeroColonne = 2 'Traitement des classeurs Do While NomClasseurAudit <> "" 'Ouvrir le classeur audit Set ClasseurAudit = Workbooks.Open(CheminClasseurAudit & NomClasseurAudit) 'Insertion nom du classeur ClasseurBilan.Sheets(1).Cells(1, NumeroColonne) = ClasseurAudit.Name 'Insertion nom du centre ClasseurBilan.Sheets(1).Cells(2, NumeroColonne) = ClasseurAudit.Sheets(1).Range("D3") 'Insertion de la date ClasseurBilan.Sheets(1).Cells(3, NumeroColonne).NumberFormat = "m/d/yyyy" ClasseurBilan.Sheets(1).Cells(3, NumeroColonne) = ClasseurAudit.Sheets(1).Range("D4") 'Insertion des deux noms ClasseurBilan.Sheets(1).Cells(4, NumeroColonne) = ClasseurAudit.Sheets(1).Range("B3") ClasseurBilan.Sheets(1).Cells(5, NumeroColonne) = ClasseurAudit.Sheets(1).Range("B4") 'Initialisiation de la premiere cellule a extraire NumeroLigneBilan = 7 NumeroLigneAudit = 13 'Synthese des resultats compris entre la première cellule des resultats et celle contenant le mot "Moyenne" While ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 2) <> "Moyenne" 'Extraction de la donnee concernee ClasseurBilan.Sheets(1).Cells(NumeroLigneBilan, NumeroColonne) = _ ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 3) 'Extraction des titres systematique au cas ou les classeurs n'ont pas tous les memes titres ClasseurBilan.Sheets(1).Cells(NumeroLigneBilan, 1) = _ ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 2) 'Donnee suivante NumeroLigneBilan = NumeroLigneBilan + 1 NumeroLigneAudit = NumeroLigneAudit + 1 Wend 'Fermer le classeur d'audit ouvert ClasseurAudit.Close SaveChanges:=False 'Colonne suivante NumeroColonne = NumeroColonne + 1 'Classeur suivant NomClasseurAudit = Dir Loop
Merci infiniment
Je commencerais à adapater votre code et des autres sur internet et je vous reviens avec les résultats