Copie de cellules de 3 classeurs différents vers un même classeur

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DEStination)

Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
CH = ThisWorkbook.Path & "\" 'définit le chemin d'accès CH
Set OD = CD.Sheets("Feuil1") 'définit l'onglet de destination OD
F = Dir(CH & "Classeur*.xlsx") 'définit le premier fichier F dans le dossier CH
Do While F <> "" 'boucle tant qu'il existe des fichier dans le dossier CH
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set CS = Workbooks(F) 'définit le classeur source (génere une erreur si le classeur n'est pas ouvert)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Workbooks.Open (F) 'ouvre la classeur F
        Set CS = ActiveWorkbook 'définit le classeur source CS
        Err = 0 'annule l'erreur
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    For Each O In CS.Sheets 'boucle sur tous les onglets O du classeur source CS
        O.Select 'sélectionne l'onglet
        DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O
        If O.Range("A5").Value <> "" Then 'condition : si la cellule A5 de l'onglet O n'est pas vide
            O.Range("A5").Select 'sélectionne la cellule A5 de l'onglet O
            Do While ActiveCell.Row <= DL 'boucle tabt que la ligne de la cellule active est inférieure ou égale à DL
                Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST dans l'onglet de destination OD
                DEST.Value = ActiveCell.Value 'renvoie le nom du projet
                DEST.Offset(0, 1).Value = ActiveCell.Offset(0, 2).Value 'renvoie la date 1
                DEST.Offset(0, 2).Value = ActiveCell.Offset(0, 3).Value 'renvoie la date 2
                DEST.Offset(0, 3).Value = ActiveCell.Offset(0, 4).Value 'renvoie le lien1
                DEST.Offset(0, 4).Value = ActiveCell.Offset(0, 5).Value 'renvoie le lien2
                ActiveCell.End(xlDown).End(xlDown).Select 'sélectionne deux fois la dernière cellule éditée en dessous de la cellule active
            Loop 'boucle
        End If 'fin de la condition
    Next O 'prochain onglet de la boucle
    CS.Close False 'ferme le classeur source CS
    F = Dir 'redéfinit le fichier F (fichier suivant)
Loop 'boucle
Application.ScreenUpdating = True 'affiche les rafraîchissement d'écran
End Sub