FUSIONNER LES DONNÉES DES FEUILLES DE PLUSIEURS CLASSEURS EXCEL EN UN SEUL CLASSEUR

Sub LaunchCompilation()
' Ce code doit servir à regrouper les données des feuilles de plusieurs classeurs Excel enregistrés dans le même dossier que ce classeur

Application.DisplayAlerts = False ' pour éviter les message demandant confirmation lors d'une fermeture (notamment le fait d'avoir des données dans le presse papier
chemin = ThisWorkbook.Path 'chemin du dossier qui contient les autres fichiers et où est enregistré ce fichier qui servira de compilateur
Set fso = New FileSystemObject 'l'utilisation des FSO nécessite l'activation de la référence Microsoft Scripting Runtime
Set dossier = fso.GetFolder(chemin) '
Dim r As Integer ' r sera le n° de la ligne de la feuille compilateur
r = 1
Dim nbfichiers ' nbfichier sera le nombre de fichiers traités
nbfichier = 0
Dim listedesfichierstraités As String

For Each fichier In dossier.Files ' boucle sur les fichiers
    If fso.GetExtensionName(fichier.Path) = "xls" And fichier.Name <> ThisWorkbook.Name Then 'sélection des fichiers à traiter : classeurs excel et pas le compilateur
    nbfichiers = nbfichiers + 1
    listedesfichierstraités = listedesfichierstraités & fichier.ShortName & Chr(10)
    Workbooks.Open fichier 'ouverture d'un fichier
    
        For i = 1 To ActiveWorkbook.Sheets.Count ' boucle sur les feuilles de ce fichier
        Sheets(i).Select 'sélection de la feuille
        
        
        Select Case i
        Case 1
        lastrow1 = Cells(65536, 3).End(xlUp).Row 'détermination de la dernière ligne à copier selon la présence de données dans la colonne C
        Range(Cells(1, 1), Cells(lastrow1, 4)).Copy 'copie des cellules de la plage A1:D dernière ligne
        ThisWorkbook.Activate 'on se place sur le fichier de compilation
        Sheets(1).Cells(r, 1).Select 'on sélectionne la 1ère feuille, et la première cellule encore vide de la colonne A
        ActiveSheet.Paste ' collage simple, si les données contiennent des formules peut-être mieux vaut un pastespecial
        Case 2
        lastrow2 = Cells(65536, 3).End(xlUp).Row 'détermination de la dernière ligne à copier selon la présence de données dans la colonne C
        Range(Cells(1, 1), Cells(lastrow2, 6)).Copy 'copie des cellules de la plage A1:F dernière ligne
        ThisWorkbook.Activate 'on se place sur le fichier de compilation
        Sheets(1).Cells(r, 5).Select 'on sélectionne la 1ère feuille, et la première cellule encore vide de la colonne E
        ActiveSheet.Paste ' collage simple, si les données contiennent des formules peut-être mieux vaut un pastespecial
        Case 3
        lastrow3 = Cells(65536, 3).End(xlUp).Row 'détermination de la dernière ligne à copier selon la présence de données dans la colonne C
        Range(Cells(1, 1), Cells(lastrow3, 3)).Copy 'copie des cellules de la plage A1:C dernière ligne
        ThisWorkbook.Activate 'on se place sur le fichier de compilation
        Sheets(1).Cells(r, 11).Select 'on sélectionne la 1ère feuille, et la première cellule encore vide de la colonne K
        ActiveSheet.Paste ' collage simple, si les données contiennent des formules peut-être mieux vaut un pastespecial
        End Select
        Cells(r, 1).EntireRow.Interior.ColorIndex = 1
        
                
        Workbooks(fichier.Name).Activate
        Next i
        
        If lastrow1 > lastrow2 And mastrow1 > lastrow3 Then
        lastrow = lastrow1
        Else
            If lastrow2 > lastrow1 And lastrow2 > lastrow3 Then
            lastrow = lastrow2
            Else
            lastrow = lastrow3
            End If
        End If
        
        r = r + lastrow 'on ajoute à r la dernière ligne pour toujours se placer sur la 1ère cellule vide de la colonne A
     
     
    Workbooks(fichier.Name).Close (False) 'on ferme le fichier ouvert précédemment
    End If
Next fichier
Application.DisplayAlerts = True 'on rétablie le paramétrage standard
Cells(1, 1).Select
MsgBox ("Le traitement est terminé." & Chr(10) & nbfichiers & " fichiers ont été traités, en voici la liste :" & Chr(10) & listedesfichierstraités)
End Sub