Re : Récupération données de plusieurs fichiers Excel contenues dans sous dossiers pa
Bon en fait voici mon code maintenant. Celui ci fonctionne lorsque mes 62 fichiers sont dans le même dossier parent global sans être chacun dans des sous dossiers. Mais dès que je les range dans 62 sous dossiers différents, eux mêmes dans mon dossier parent global, là ça ne fonctionne plus.... Je ne trouve pas mon erreur. Pourtant j'ai essayé beaucoup de choses. fredl avez vous des idées miracles ...? Merci d'avance
Sub ScanRepertoiresFichiersEtRepercutionBilan()
Dim Dossier As Object, Fichier As Object
Dim Chemin As String, CeFichier As String, ExtFichier As String
Dim TabDossiers As Variant
Dim n As Long, D As Long
Dim Fichier2 As Range
Dim titre As String
Dim wbk1 As Workbook 'fichier bilan ouvert et qui contient la macro
Dim wbk2 As Workbook 'fichier(s) à ouvrir
Set wbk1 = ThisWorkbook 'ton fichier bilan ouvert
Application.DisplayAlerts = False
Chemin = CheminUser
If Chemin = "" Then Exit Sub
Application.ScreenUpdating = False
CeFichier = ThisWorkbook.Name
n = 3
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é
Set wbk2 = Workbooks.Open(Chemin & Fichier.Name)
wbk1.Sheets(1).Range("A" & n).Value = wbk2.Sheets(10).Range("G1").Value 'bizarre mais sheets 10 correspond à septembre
wbk1.Sheets(1).Range("B" & n).Value = wbk2.Sheets(10).Range("N1").Value 'bizarre mais sheets 10 correspond à septembre
wbk2.Close
n = n + 1
'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, D 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 D In Dossier.subfolders
ReDim Preserve TabTemp(1 To UBound(TabTemp) + 1)
TabTemp(UBound(TabTemp)) = D.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
Function CheminUser() As String
Dim objShell As Object, objFolder As Object
Dim Chemin As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Sélectionnez dans l'arborescence :", 513, 0)
If objFolder Is Nothing Then Exit Function
On Error Resume Next
Chemin = objFolder.Items.Item.Path & "\"
On Error GoTo 0
If Left(Chemin, 1) = ":" Then Chemin = ""
CheminUser = Chemin
End Function