Extraction de données à partir de plusieurs classeurs excel

Sub Macro1()
Dim cr As Workbook 'déclare la variable cr (Classeur Resultat)
Dim r1 As Object 'déclare la variable r1 (onglet Réception 1)
Dim r2 As Object 'déclare la variable r2 (onglet Réception 2)
Dim paf As Range 'déclare la variable paf (Plage A Effacer)
Dim ch As String 'déclare la variable ch (CHemin)
Dim sf As Object 'déclare la variable sf (Système de Fichiers)
Dim d As Object 'déclare la variable d (Dossier)
Dim o As Object 'déclare la variable o (Onglets)
Dim fs As Object 'déclare la variable fs (FichierS)
Dim f As Object 'déclare la variable f (Fichier)
Dim cd As Workbook 'déclare la variable cd (Classeur de Données)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim i As Byte 'déclare la variable i (Incrément)
Dim lo As String 'déclare la variable lo (Longueur d'Onde)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set cr = ThisWorkbook 'définit le classeur resultat cr
Set r1 = cr.Sheets("Données brutes UV") 'définit l'onglet de réception1  r1
Set r2 = cr.Sheets("Données brutes Fluo") 'définit l'onglet de réception2  r2
Set paf = r1.Range("A1").CurrentRegion 'définit la plage à effacer paf
If paf.Rows.Count > 1 Then 'si paf à plus d'une seule ligne
    Set paf = paf.Offset(1, 0).Resize(paf.Rows.Count - 1, paf.Columns.Count) 'redéfinit paf (sans la première line)
    paf.Clear 'supprime les anciennes données
End If 'fin de la condition
Set paf = r2.Range("A1").CurrentRegion 'définit la plage à effacer paf
If paf.Rows.Count > 1 Then 'si paf à plus d'une seule ligne
    Set paf = paf.Offset(1, 0).Resize(paf.Rows.Count - 1, paf.Columns.Count) 'redéfinit paf (sans la première line)
    paf.Clear 'supprime les anciennes données
End If 'fin de la condition
ch = cr.Path 'définit la chemin
Set sf = CreateObject("Scripting.FileSystemObject") 'définit la variable sf
Set d = sf.getfolder(ch) 'définit la variable d
Set fs = d.Files 'définit la variable fs
For Each f In fs 'boucles 1 : sur touts les fichiers du dossier d
    If Right(f.Name, 5) = ".xlsx" And Left(f.Name, 2) = "GM" Then
        Workbooks.Open f 'ouvre le fichier
        Set cd = ActiveWorkbook 'définit le classeur de données cd
        For Each o In cd.Sheets 'boucle 2 : sur tous les onglets du classeur cd
            Select Case o.Name 'agit en fonction du nom de l'onglet
                Case "IntResults1", "IntResults2", "IntResults3" 'cas "IntResults1" à "IntResults3"
                    dl = o.Cells(Application.Rows.Count, 5).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 5 (=E)de l'onglet o du classeur cd
                    If o.Cells(dl, 5).Value = "" Then GoTo suite 'si aucune cellule éditée en colonne E, va à l'étiquette "suite"
                    Set dest = r1.Cells(Application.Rows.Count, 3).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest (colonne C)
                    o.Range("E2:H" & dl).Copy dest 'copie la plage éditée et la colle dans dest
                    r1.Cells(dest.Row, 1).Resize(dl - 1, 1).Value = cd.Name 'place le nom du classeur
                    If o.Name = "IntResults1" Then lo = "310 nm" 'définit la longueur d'onde lo
                    If o.Name = "IntResults2" Then lo = "254 nm" 'définit la longueur d'onde lo
                    If o.Name = "IntResults1" Then lo = "280 nm" 'définit la longueur d'onde lo
                    r1.Cells(dest.Row, 2).Resize(dl - 1, 1).Value = lo 'place le nom du classeur
                Case "IntResults4" 'cas "IntResults4"
                    dl = o.Cells(Application.Rows.Count, 5).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 5 (=E)de l'onglet 4 du classeur cd
                    If o.Cells(dl, 5).Value = "" Then GoTo suite 'si aucune cellule éditée en colonne E, va à l'étiquette "suite"
                    Set dest = r2.Cells(Application.Rows.Count, 3).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest (colonne C)
                    o.Range("E2:H" & dl).Copy dest 'copie la plage éditée et la colle dans dest
                    r2.Cells(dest.Row, 1).Resize(dl - 1, 1).Value = cd.Name 'place le nom du classeur
                    r2.Cells(dest.Row, 2).Resize(dl - 1, 1).Value = "Fluo" 'place la longueur d'onde lo
            End Select
suite:
        Next o
        cd.Close 'ferme le classeur de données
    End If
Next f
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub