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.

pijaku a écrit :

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)