Erreur d'exécution 438

  • Initiateur de la discussion Initiateur de la discussion Ked_miv
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Ked_miv

XLDnaute Nouveau
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 :


Code:
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

Code:
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 :


[
Code:
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:
Code:
Selection.Paste


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

Merci par avance.

Salutations.
 
Dernière édition:
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.

Code:
'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 !
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
236
Réponses
4
Affichages
461
Réponses
4
Affichages
177
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
Réponses
2
Affichages
330
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
169
Retour