Récupération données de plusieurs fichiers Excel contenues dans sous dossiers parents

lancelot92

XLDnaute Nouveau
Bonjour à tous,

J'ai un problème avec VBA que je n'arrive pas à résoudre en entier.Celui-ci est en deux partie dont je n'ai réussi à résoudre que la première. Je m'explique.

1) Je souhaitais, grâce à une macro d'un fichier de suivi, récupérer des données contenues dans des cellules bien précises d'un fichier excel _ celles-ci devant être copiées et collées dans mon fichier de suivi dans un tableau.
Voici mon code :

Sub suivi1_5S()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim titre As String
Dim wbk1 As Workbook
Dim wbk2 As Workbook
titre = "G:\Audit\Audits 5S\PROJET\Sauvegarde Audits 5S 2014\LIGN DR2\LIGN_DR2.xlsm"
Set wbk1 = ThisWorkbook
Set wbk2 = Workbooks.Open(titre)
wbk1.Sheets(1).Range("A2").Value = wbk2.Sheets(2).Range("D45").Value
wbk1.Sheets(1).Range("B2").Value = wbk2.Sheets(2).Range("F36").Value
wbk2.Close
End Sub

Tout fonctionne parfaitement.

2) En fait, je n'ai pas un seul fichier dont les données m'intéressent. J'en ai 62. Chacun de ces fichiers est contenu dans un sous-dossier, et ces 62 sous dossiers sont contenus dans un seul et même dossier parent.
Aussi, comme les sous dossiers ou fichiers peuvent êre modifiés, mon but est de demander à VBA qu'il balaye tous les fichiers du dossier parent, et que, lorsqu'il trouve un fichier, il copie les valeurs des cellules (ce sont les mêmes qui m'intéressent pour les 62 fichiers) et les écrit dans mon tableau de suivi où il y a la macro, en incrémentant pour que le tableau se construise automatiquement.

J'ai tenté des choses avec SourceFolder, mais je ne sais pas comment m'y prendre.

Auriez - vous des idées de codes à rajouter sur mon codes initial ?

Un grand merci d'avance.
 

fredl

XLDnaute Impliqué
Re : Récupération données de plusieurs fichiers Excel contenues dans sous dossiers pa

Ouf....
Ca y est, cela me semble bon.
Je te laisse tester et me tenir informé.
A+
Frédéric
 

Pièces jointes

  • ListeFichiersDsRepEtSousRep.xlsm
    135.5 KB · Affichages: 28
  • ListeFichiersDsRepEtSousRep.xlsm
    135.5 KB · Affichages: 33
  • ListeFichiersDsRepEtSousRep.xlsm
    135.5 KB · Affichages: 30

lancelot92

XLDnaute Nouveau
Re : Récupération données de plusieurs fichiers Excel contenues dans sous dossiers pa

Frédérique j'ai des soucis au niveau de la ligne
Set wbk2 = Workbooks.Open(Chemin & Fichier.Name)

En effet, j'ai toujours un message d'erreur comme quoi il impossible d'éxécuter la méthode "open".
Peut-être devrais-je préciser que l'extension de fichier que je veux est xlsm ?

Je vous transmets le fichier en pièce jointe.

Avez-vous des idées ? Merci d'avance
 

Pièces jointes

  • ListeFichiersDsRepEtSousRep (1).xlsm
    24.5 KB · Affichages: 23

lancelot92

XLDnaute Nouveau
Re : Récupération données de plusieurs fichiers Excel contenues dans sous dossiers pa

Bon j'ai modifié
If ExtFichier = "" Or UCase(Right(Fichier.Name, 3)) = ExtFichier Then
par
If ExtFichier = "xlsm" Then

Quand je lance la macro je n'ai pas de message d'erreur mais rien ne se passe...
 

lancelot92

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

fredl

XLDnaute Impliqué
Re : Récupération données de plusieurs fichiers Excel contenues dans sous dossiers pa

Bonjour,
Comment sont articules tes 62 sous dossiers?
Au meme niveau dans le dossier parent ou en cascade sous le dossier parent?

J'ai testé avec succes la macro avec des dossiers en cascade sous le dossier parent.
Frédéric
 

fredl

XLDnaute Impliqué
Re : Récupération données de plusieurs fichiers Excel contenues dans sous dossiers pa

Comprend pas :
de mon côté, cela marche! (cf fichier joint - essai avec 4 fichiers ds 4 rep au meme niveau sous le dossier parent)
Si le pb persiste envoie moi une copie d'écran de ton arborescence)
Frédéric
 

Pièces jointes

  • ListeFichiersDsRepEtSousRep.xlsm
    23.9 KB · Affichages: 32
  • ListeFichiersDsRepEtSousRep.xlsm
    23.9 KB · Affichages: 30
  • ListeFichiersDsRepEtSousRep.xlsm
    23.9 KB · Affichages: 33

Discussions similaires