Extraction VBA depuis plusieurs fichiers XL
Bonjour à tous,
Il y a quelques temps, j'ai réalisé une matrice VBA afin d'extraire les données depuis plusieurs classeurs Excel. Avec l'aide d'un forumeur, j'ai une matrice qui marche très bien. Elle ouvre le fichier copie/colle les résultats (selon la plage donnée) puis referme le classeur et passe au fichier suivant. Impeccable !
Seulement voila, au lieu de copier tous les résultats trouvés dans la colonne A avec saut de ligne entre chaque classeur, je souhaiterais que les résultats soient coller en ligne. Malgré mes recherche, je n'y arrive pas !
Par exemple, la première extraction copie les résultats de la plage de G6 à G20, pour colle
chaque résultat en ligne (A1, B1, C1, D1 etc...). la deuxième extraction copie les résultats de la plage de G6 à G20, pour colle chaque résultat en ligne (A2, B2, C2, D2 etc...). Et ainsi de suite pour tous les classeurs.
Je vous joins la matrice en complément.
En vous remerciant de votre aide précieuse.
Bonjour,
Peut être avec une solution plus simple à mettre en œuvre qu'une connexion ADODB, qui plus est tu n'aurais plus besoin de la Sub LireFichierFermé.
Pour cela, nous allons utiliser les plages nommées et les formules Excel. La feuille "Requete" sert de feuille intermédiaire et la feuille Feuil1 est la feuille de destination des données... A adapter, bien entendu, comme tu le souhaites.
Sub Extraction2()
Dim Principal As ThisWorkbook
Dim Repertoire As String, fichier As String
Application.ScreenUpdating = False
Set Principal = ThisWorkbook
'Repertoire = "C:\Users\Chris\Desktop\extract2"
Repertoire = ThisWorkbook.Path
ChDir Repertoire
xFichier = Dir("*.xls")
Do While xFichier <> ""
If xFichier <> Principal.Name Then
xLig = Sheets("Feuil1").Range("A65536").End(xlUp).Row + 2
ThisWorkbook.Names.Add "plage", RefersTo:="='" & Repertoire & "\[" & xFichier & "]Feuil1'!$G$6:$G$20"
With Sheets("Requete")
.[G6:G20] = "=plage"
.[G6:G20].Copy
Sheets("Feuil1").Range("A" & xLig).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
.[G6:G20].Clear
End With
End If
xFichier = Dir
Loop
ThisWorkbook.Names("plage").Delete
End Sub
Bonjour,
C'est parfait !
Merci beaucoup, c'est très aimable de votre part.
Bonjour,
Peut être avec une solution plus simple à mettre en œuvre qu'une connexion ADODB, qui plus est tu n'aurais plus besoin de la Sub LireFichierFermé.
Pour cela, nous allons utiliser les plages nommées et les formules Excel. La feuille "Requete" sert de feuille intermédiaire et la feuille Feuil1 est la feuille de destination des données... A adapter, bien entendu, comme tu le souhaites.
Sub Extraction2() Dim Principal As ThisWorkbook Dim Repertoire As String, fichier As String Application.ScreenUpdating = False Set Principal = ThisWorkbook 'Repertoire = "C:\Users\Chris\Desktop\extract2" Repertoire = ThisWorkbook.Path ChDir Repertoire xFichier = Dir("*.xls") Do While xFichier <> "" If xFichier <> Principal.Name Then xLig = Sheets("Feuil1").Range("A65536").End(xlUp).Row + 2 ThisWorkbook.Names.Add "plage", RefersTo:="='" & Repertoire & "\[" & xFichier & "]Feuil1'!$G$6:$G$20" With Sheets("Requete") .[G6:G20] = "=plage" .[G6:G20].Copy Sheets("Feuil1").Range("A" & xLig).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True .[G6:G20].Clear End With End If xFichier = Dir Loop ThisWorkbook.Names("plage").Delete End Sub
5 ans déjà ! mais le cas d'extraction des données est toujours utiles
puis-je avoir de l'aide pour extraire des données de plusieurs fichiers excel (qui se trouvent dans des chemins d’accès différents) vers un seul fichier servant comme bilan ou synthèse
En Effet, j'ai plusieurs fichiers excel répartis sur 3 dossiers (Vente, Achat, Location)
Chacun de ces dossiers contient des fichiers excel ( .xls ; .xlsx et .xlsm)
J'ai besoin de synthétiser,avec macro, dans un fichier excel nommé BILAN le contenue,personnalisé*, de chacun des fichiers des 3 dossiers
*contenue personnalisé: preciser les cellules à extraire dans le code VBA, car les fichiers ne sont pas toujours de la même structure
Ci-Joint le dossier avec simulation du resultat
(le Dossier "Dossiers TEST" est directement placé sur le racine C: lors de ma simulation)