Bonjour à tous,
 
Je viens à vous pour un petit conseil par rapport à une macro vba que j'ai construit dans le but de :
Récupérer des données de fichiers (dans des cellules bien précises), chacun d'eux étant contenu dans un sous dossiers, et les 53 sous dossiers sont contenus dans un même dossier. La macro se réalise grâce au chemin du dossier contenant.  
Problème la macro s'exécute mais au bout de 15 sous dossiers ouverts (environ) j'ai un message d'erreu comme quoi la fonction Workbooks.open ne peut pas être exécutée. Auriez vous une idée du problème..?
Merci d'avance, voici mon code :
 
 
Option Explicit
 
Sub ScanRepertoiresFichiersEtRepercutionBilan()
 
Dim Dossier As Object, Fichier As Object
Dim Chemin1 As String
Dim Chemin As String, CeFichier As String, ExtFichier As String
Dim TabDossiers As Variant
Dim n As Long, D As Long
Dim PlFichier As Range
Dim titre As String
Dim wbk1 As Workbook 'fichier suivi ouvert et qui contient la macro
Dim wbk2 As Workbook 'fichiers à ouvrir
 
Set wbk1 = ThisWorkbook 'fichier bilan ouvert
 
    Application.DisplayAlerts = False
    Chemin = "G:\Audit\Audits 5S\PROJET\Sauvegarde Audits 5S 2014"
    If Chemin = "" Then Exit Sub
    Application.ScreenUpdating = False
    CeFichier = ThisWorkbook.Name
    n = 2
    TabDossiers = lstDossiers(Chemin, True)
    For D = 1 To UBound(TabDossiers)
        'Chemin du dossier (ou sous-dossier) à analyser
        Chemin = TabDossiers(D)
        If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
        'Analyse du dossier (ou sous-dossier)
        Set Dossier = CreateObject("Scripting.FileSystemObject" ).GetFolder(Chemin)
      For Each Fichier In Dossier.Files
            If Fichier.Name <> CeFichier Then
                    'action sur le fichier detecté
                    If ExtFichier = "" Or UCase(Right(Fichier.Name, 1)) = ExtFichier Then
                                   Set wbk2 = Workbooks.Open(Chemin & Fichier.Name)
                                    wbk1.Sheets(1).Range("A" & n).Value = wbk2.Sheets(12).Range("G1" ).Value
                                    wbk1.Sheets(1).Range("B" & n).Value = wbk2.Sheets(12).Range("C46" ).Value
                                    wbk1.Sheets(1).Range("C" & n).Value = wbk2.Sheets(12).Range("R2" ).Value
                                    wbk1.Sheets(1).Range("D" & n).Value = wbk2.Sheets(12).Range("E33" ).Value
                                    wbk1.Sheets(1).Range("E" & n).Value = wbk2.Sheets(12).Range("E34" ).Value
                                    wbk1.Sheets(1).Range("F" & n).Value = wbk2.Sheets(12).Range("F37" ).Value
                                    wbk1.Sheets(1).Range("G" & n).Value = wbk2.Sheets(12).Range("Y3" ).Value
                                    wbk1.Sheets(1).Range("H" & n).Value = wbk2.Sheets(12).Range("AH3" ).Value
                                    wbk2.Close
                                    n = n + 1
                    End If
                    'fin de l'action sur le fichier
            End If
        Next
    Next D
    Set Dossier = Nothing
    'Rétablit l'alerte de lien éventuelle dans les options Excel
    Application.ScreenUpdating = True
     
End Sub
 
 
Private Function lstDossiers(Chemin As String, Optional Debut As Boolean) As Variant
Dim Dossier As Object, SD As Object, C As Object
Static TabTemp() As String
    If Debut Then
        ReDim TabTemp(1 To 1)
        TabTemp(1) = Chemin
    End If
    Set Dossier = CreateObject("Scripting.FileSystemObject" ).GetFolder(Chemin)
    'examen du dossier courant
    For Each C In Dossier.subfolders
        ReDim Preserve TabTemp(1 To UBound(TabTemp) + 1)
        TabTemp(UBound(TabTemp)) = C.Path
    Next
    'Traitement récursif des sous-dossiers
    For Each SD In Dossier.subfolders
      lstDossiers SD.Path
    Next SD
    lstDossiers = TabTemp()
    Set Dossier = Nothing
End Function
 

 
            Bonjour.
 
            Conformément aux règles du forum :
 
            • merci d'éditer le post et de baliser le code via l'icône dédiée !
 
            • Indiquer le n° de la ligne du code déclenchant cette erreur ainsi que le n° d'erreur et son message …
 
            Vérifier si le chemin existe, ses propriétés comme celles du fichier …
            Voir aussi la fonction VBA Dir pour parcourir les fichiers.
            Utiliser l'instruction With … End With permettrait d'alléger le code …
  

 
Bonjour Marc L,
 
Désolé pour les oublis, j'y ferai attention.
 
Je vais essayer avec la fonction Dir. Sinon mon chemin est bon dans la mesure où les données se remplissent dans mon fichier wbk1 pour les 15 premiers fichiers wbk2 mais après j'obtiens le message d'erreur 1004.