Help - Fusion de classeur excel

Bonsoir Wikika,

Ci-joint ton fichier : https://www.cjoint.com/c/HIrtzZ78PpN

- feuille "récap" où vont venir s'ajouter les lignes de tes classeurs
- feuille "lien" ou tu saisies les chemins de tes fichier en colonne A et le nom des fichiers en colonne B (avec extension)

Lorsque tu lances la macro, si les fichiers sont fermés la macro les ouvres, copie les données de chaque feuille dans la feuille récap, ferme le fichier et passe au suivant.

NB : il n'y a pas de notion de mise à jour, c'est a dire que la macro n'analyse pas ce qui est déjà présent dans récap pour ajouter ce qui n'y serait pas c'est pourquoi à chaque lancement de la macro j'ai programmer la suppression intégrale de la feuille récap puis ensuite l'ajout des données de tes classeurs.

Bonne soirée

Jc

merci JC

Le seul pb c'est que chaque mois les fichiers vont changer de nom, donc assez fastidieux de réécrire dans l'onglet lien chaque nom de fichier.

L'idée serait de lancer une boucle qui vient automatiquement récupérer les fichiers sans se soucier de leur nom .

bien à toi

Si d'autres solution en complément de celle de JC je suis preneur
bien à vous

Essaye ce code en mettant a jour le chemin du dossier

Option Explicit
Sub Traitement()
    
    Dim Wbs As Workbook
    Set Wbs = ActiveWorkbook
    
    Dim lien As Worksheet, recap As Worksheet
    Set recap = Wbs.Sheets("recap")
    
    'supprime les information existantes
    If recap.Range("A65536").End(xlUp).Row > 1 Then
    recap.Range("A2:H" & recap.Range("A65536").End(xlUp).Row).Clear
    End If
    
    Dim I As Long, k As Long, j As Long, der As Long, lig As Long
    Dim ws As Worksheet
    lig = 2
    
    Dim Fichier As String, Chemin As String

    Dim Wb As Workbook

 
    Chemin = "C:\Users\JC\Desktop\Essai\" 'a mettre à jour
    Fichier = Dir(Chemin & "*.xls")

    Do While Fichier <> ""

    Set Wb = Workbooks.Open(Chemin & Fichier)
 
        'Traitement du fichier
        'copie des informations de chaque feuilles des classeurs
        For k = 1 To ActiveWorkbook.Worksheets.Count
        Set ws = ActiveWorkbook.Worksheets(k)
        der = ws.Range("A65536").End(xlUp).Row
            For j = 2 To der
            ws.Rows(j).Copy Wbs.Sheets("Recap").Rows(lig)
            lig = lig + 1
            Next j
        Next k
        'Fermeture du fichier
        Wb.Close True

        Set Wb = Nothing

        Fichier = Dir
        
        Loop
         
End Sub