Fusionner plusieurs fichiers Excel en un seul

Bonjour,

Malgré des recherches dans le forum, je n'arrive pas à trouver la réponse à ma question. Je cherche à unir plusieurs fichiers Excel ayant la même forme en un seul fichier.

J'ai 26 fichiers ayant les même noms de colonnes qui sont dans dans le dossier : C:\Users\ragagne\Desktop\Dossier PCO.zip

Je n'arrive pas à trouver le bon code pour unir tous mes fichiers en un seul!

Merci d'avance

Bonjour RachelG,

Voici un exemple,

Avant d’exécuter la macro, n’oublie pas de modifier les lignes qui ont un commentaire « à adapter »

Option Explicit
'nécessite d'activer la référence: Microsoft ActiveX Data Objects xx Library

Sub RequeteClasseurFerme()
Dim Feuille As String, Repertoire As String, Ligne As Long
Dim fso, sfofolder, oFile
Dim Cnn, texte_SQL As String, Rst As ADODB.Recordset

Repertoire = "C:\Users\isabelle\Documents\Test3"  'à adapter
Feuille = "Feuil1"      'à adapter
Ligne = 2
Sheets.Add After:=Sheets(Sheets.Count)  'optionnelle

Set fso = CreateObject("Scripting.FileSystemObject")
Set sfofolder = fso.GetFolder(Repertoire)

For Each oFile In sfofolder.Files
    If Right(oFile, 5) = ".xlsx" Then  'à adapter

        Set Cnn = New ADODB.Connection
        '--- Connexion ---
        With Cnn
            .Provider = "Microsoft.Jet.OLEDB.12.0"
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
                        & oFile & ";Extended Properties=""Excel 12.0;;"""
            .Open
        End With

        'Définit la requête.
        texte_SQL = "SELECT * FROM [" & Feuille & "$]"

        Set Rst = New ADODB.Recordset
        Set Rst = Cnn.Execute(texte_SQL)

        'Ecrit le résultat de la requête dans la cellule A2
        Range("A" & Ligne).CopyFromRecordset Rst
        Rst.Close
        Ligne = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
    End If
Next
'--- Fermeture connexion ---
Cnn.Close
Set Rst = Nothing
Set Cnn = Nothing
End Sub