Erreur d'exécution 438

Sub Jetraite(Repertoire As String)
    
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.file
    Dim Dlig As Long
    Dim Dcol As Long
    Dim D As Range
    
       
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
    
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
                
        
        
        If (InStr(1, FileItem.Name, "FONC") > 0) Then
                
            Workbooks.Open (FileItem.ParentFolder & "\" & FileItem.Name)
            
            With Sheets("Source")
                'Dernière ligne non vide de la feuille "Source"
                 Dlig = Range("A" & Rows.Count).End(xlUp).Row
                'Dernière colonne non vide de la feuille "Source"
                 Dcol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
                'Plage à copier
                .Range("A1", Cells(Dlig, Dcol)).Select
                Selection.Copy
            End With
                      
            'On se replace sur la le fichier courant
            ThisWorkbook.Activate
            With Sheets("Destination")
                 'On effacee toutes les cellules de la feuille "Destination"
                 Cells.ClearContents
                 .Range(Cells(1, 1), Cells(Dlig, Dcol)).Select
                  Selection.Paste
            End With
            'On enregistre le fichier courant
            ThisWorkbook.Save
            
            'On revient sur le fichier  parcouru  qu'on ferme sans enregistrer
            Windows(FileItem.Name).Activate
            ActiveWorkbook.Close savechanges:=False
       End If
    
    
    Next FileItem
    Application.Quit
End Sub

Sub Execution()
Dim dossiers As String
dossiers = "D:\Contenant\"
Jetraite (dossiers)
End Sub

Erreur d'éxécution '438': 
Propriété ou méthode non gérée par cet objet

Selection.Paste