Copier une selection de cellule depuis plusieurs classeur EXCEL

Sub CumulDonnee()

    ' Déclaration des variables
    Dim i, j, k, l, m, n As Integer: i = 1
    Dim wb As Workbook
    
    
    Chemin = "C:\Users\PYMI06881\Desktop\test\"

    Fichier = Dir(Chemin & "*.xls")
    
    Set ClasseurSource = ActiveWorkbook

    ' Attribut les noms des classeurs et le chemin (ici le même dossier que le classeur qui compile les données)
    'Set ClasseurSource = ActiveWorkbook
    'Set wb = Workbooks.Open(Path & "C1.xlsx")

    
    Application.ScreenUpdating = False
    
    Do While Fichier <> Chemin & "Compilation.xls"
    
    Set wb = Workbooks.Open(Chemin & Fichier)
    
    ' Traite les lignes à copier du wb - 500 lignes de A500 à C500
    ' Commence à la ligne 2 (On ne prend pas en compte les en-tête des tableaux du wb)
    For k = 2 To 500
    
     'wb = Workbooks.Open(Fichier)
    
        If wb.Sheets("Feuil1").Cells([k], 1) <> "" Or wb.Sheets("Feuil1").Cells([k], 2) <> "" Or wb.Sheets("Feuil1").Cells([k], 3) <> "" Then
        With wb
            .Sheets("Feuil1").Range("A" & k & ":J" & k).Copy
        End With
        With ClasseurSource.Sheets("Données compilées")
        .Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        i = i + 1
        End With
        End If
        
        ' Fermeture des classeurs
    wb.Close True
    Set wb = Nothing

Fichier = Dir
       
    Next
    
Loop
    
    Application.ScreenUpdating = True
 
       
End Sub

Sub CumulDonnee()

    ' Déclaration des variables
    Dim i, k As Integer: i = 1
    Dim wb, ClasseurSource As Workbook
    Dim Chemin As String
    
    ' Attribut
    Chemin = "C:\Users\PYMI06881\Desktop\test\"
    Fichier = Dir(Chemin)
    Set ClasseurSource = ActiveWorkbook
    
    Application.ScreenUpdating = False
    
    Do While Fichier <> "Compilation.xls"

        Set wb = Workbooks.Open(Fichier)
    
        ' Traite les lignes à copier du wb - 500 lignes de A500 à C500
        ' Commence à la ligne 2 (On ne prend pas en compte les en-tête des tableaux du wb)
        For k = 2 To 500
        
            If wb.Sheets("Feuil1").Cells([k], 1) <> "" Or wb.Sheets("Feuil1").Cells([k], 2) <> "" Or wb.Sheets("Feuil1").Cells([k], 3) <> "" Then
                wb.Sheets("Feuil1").Range("A" & k & ":J" & k).Copy
                ClasseurSource.Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                i = i + 1
            End If
            
            ' Fermeture des classeurs
            wb.Close True
            Set wb = Nothing
            
        Next
       
        Fichier = Dir
    
    Loop
    
    Application.ScreenUpdating = True
 
End Sub