Excel 2007 fusion des feuilles de classeurs différents

Bonjour à tout le monde,

Je viens solliciter votre aide car je dois créer une macro qui permet de sélectionner des fichiers excel de même type( depuis un répertoire) et fusionner certaines feuilles des fichiers sélectionnés.

En exemple je vous joints trois fichiers.

Fichier1 et Fichier2 sont les deux fichiers que doit choisir l'utilisateur et la fusion doit donner le fichier3.

J’espère être clair et si c'est pas le cas je suis à votre disposition.

Merci d'avance de votre aide

Saliou.

Bonjour,

Un essai à adapter suivant tes besoins (chemin fichiers).

A te lire.

Cdlt

Option Explicit
Private Sub cmdConsolider_Click()
'Nécessite d'activer la référence
    'Microsoft ActiveX Data Objects 2.8 Library (à adapter suivant version Excel, je pense!)
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim xConnect As String, Cible As String
Dim Fichier As String, Dossier As String, Feuille As String
Dim i As Long

    With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    End With

    'nom du répertoire contenant les classeurs à regrouper
    Dossier = "C:\users\Administrateur\Documents\Consolidation"
    'Nom de la feuille dans les classeurs fermés
    'Ne pas oublier le symbole $ après le nom de la feuille
    Feuille = "Base$"
    i = 2
    Fichier = Dir(Dossier & "\*.xls")

    'boucle sur les fichiers du repertoire
    Do While Len(Fichier) > 0
        'MsgBox Dossier & "\" & Fichier
        xConnect = "DRIVER={Microsoft Excel Driver (*.xls)};" & _
        "ReadOnly=1;DBQ=" & Dossier & "\" & Fichier
        'connection classeur
        Set Cn = New ADODB.Connection
        Cn.Open xConnect

        'Requete
        Cible = "SELECT * FROM [" & Feuille & "];"

        Set Rs = New ADODB.Recordset
        Rs.Open Cible, xConnect, adOpenStatic, adLockOptimistic, adCmdText
        j = 1
        'Ecriture dans la feuille de calcul
        If Not Rs.EOF Then Cells(i, 1).CopyFromRecordset Rs
        i = Cells(i, 1).End(xlDown).Row + 1

        Rs.Close
        Cn.Close
        Set Cn = Nothing
        Set Rs = Nothing
        Fichier = Dir()
    Loop

    'MsgBox "Terminé"

    With Application
        .DisplayAlerts = True
    End With

End Sub

Rebonjour Jean-Eric,

Merci pour ton aide.

C'est exactement ce que je cherchais en partie car maintenant je veux donner la possibilité à l'utilisateur de choisir les fichiers qu'il veut merger.

Saliou.