Erreur d'exécution 438

[Ked_miv]

Bonjour le forum,


Après plus 72 heures de recherches infructueuses je viens solliciter votre aide.

Mon problème est le suivant je dispose d'un dossier nommé "Contenant" dans lequel j'ai un fichier Rapport.xlsm et 5 fichiers xls dont les noms débutent par "FONC_" ( FONC_01, FONC_02...) et chaque fichier FONC_"i" contient une feuille nommé "Source".


Je souhaite donc copier le contenu de chaque feuille "source" des fichiers FONC_"i" afin de le coller à chaque fois sur la feuille "Destination" du fichier Rapport.xlsm


Le code que j'ai concoté est le suivant :

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

Quand je lance ma procédure Execution j'ai le message d'erreur :


[

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

et le Débogage me place sur cette ligne-ci:

Selection.Paste

Quelqu'un aurait-il une piste ou une solution à me proposer,

Merci par avance.

Salutations.

 

[Paf]

Re : Erreur d'exécution 438

Bonjour

peut-être avec ces changements:
suppression des select et activate qui ralentissent l'exécution
modification de la suppression des données de ThisWorkbook.Sheets("Destination") à chaque itération, car au final il n'y aura que les données du dernier fichier ouvert.

'On efface toutes les cellules de la feuille "Destination"
ThisWorkbook.Sheets("Destination").Cells.ClearContents 
   
 For Each FileItem In SourceFolder.Files
        If (InStr(1, FileItem.Name, "FONC") > 0) Then
  Set WBsource = Workbooks.Open (FileItem.ParentFolder & "\" & FileItem.Name)


            
            With WBsource.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
                'copie de la plage  à partir de la première ligne libre feuille destination 
                 DerL=ThisWorkbook.Sheets("Destination").Range("A" & Rows.Count).End(xlUp).Row +1
                .Range("A1", Cells(Dlig, Dcol)).Copy ThisWorkbook.Sheets("Destination").Range("A" & DerL)             
            End With

Si vous déclarez les variables, penser à rajouter la déclaration de WBsource as WorkBook et DerL as Long

A+

Edit .Range("A1", Cells(Dlig, Dcol)).Copy et ThisWorkbook.Sheets("Destination").Range("A" & DerL) sont sur la même ligne de code !

 

[Ked_miv]

Re : Erreur d'exécution 438

Bonjour XLDnaute Accro ,

Merci de l'intérêt que vous portez à mon problème, effectivement ça marche désormais.


Grand merci en tout cas .


Bonne journée.