Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

macro fonctionnant dans les sous-répertoire

Créer une discussion

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 !

S'inscrire
F

flosauveur69

XLDnaute Occasionnel
Bonjour à tous,

J'ai une macro qui fonctionne quand je met le classeur mère dans le dossier où se trouve les classeurs fils.

Cependant, j'aimerais que le classeur mère se trouvent à l'extérieur du dossier où se trouvent les classeurs fils. Jusque là ça va mais les classeurs fils sont en fait dans des sous répertoire du dossier.

Dans la macro ci-dessous, j'ai donc remplacé cette ligne

strFile = Dir(ThisWorkbook.Path & "\*.xls")

par

strFile = Dir("D:\Documents and Settings\fl\Bureau\excel" & "\SousRepertoire\*.xls")

cependant cela ne fonctionne pas

Private Sub cmdRecupere_Click()
Dim intFile As Integer
Dim strWB As String
Dim strFile As String
Dim lgDerLig As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

' Nom du classeur actuel
strWB = ThisWorkbook.Name

lgDerLig = 2

' Récupération du premier fichier dans le répertoire et sous repertoire
strFile = Dir(ThisWorkbook.Path & "\SousRepertoire\*.xls")

' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls" et si son nom n'existe pas en colonne C
If strFile <> strWB And Worksheets("Feuil1").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & "\" & strFile

' Sélectionner le 1er onglet
ActiveWorkbook.Worksheets(1).Activate
' Copier la sélection dans le classeur
Worksheets(1).Range("A13:B28").Copy Destination:=Workbooks(strWB).Worksheets("Feuil1").Range("A" & lgDerLig)
Workbooks(strWB).Worksheets("Feuil1").Range("C" & lgDerLig) = strFile
lgDerLig = lgDerLig + 16 'il me semble, puique la hauteur copiée est de 16...

' Fermeture du classeur
Workbooks(strFile).Close
End If

' Classeur suivant
strFile = Dir
Loop

MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub



MERCI de votre aide
 
Trier par date Trier par votes
Re : macro fonctionnant dans les sous-répertoire

Bonsoir flosauveur69 ,le forum
Code: 
alors ton chemin tu es sur qu'il existe ?  Il paraît bizarre!!!!
strFile = Dir("D:\Documents and Settings\fl\Bureau\[COLOR=Red]excel[/COLOR]" & "\[COLOR=Red]SousRepertoire[/COLOR]\*.xls")
a+
papou 🙂

EDIT bonsoir Bruno
 
Dernière édition:
Vote positif 0 Vote négatif
Re : macro fonctionnant dans les sous-répertoire

Salut Flosauveur69, Paritec 😉

Ton problème viens du chemin d'accès que tu ne mets pas dans une variable, d'où une erreur quand tu veux ouvrir ton classeur

VB: 
Private Sub cmdRecupere_Click()
  Dim intFile As Integer
  Dim strWB As String
  Dim strFile As String
  Dim lgDerLig As Long
  Dim VPath As String
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  ' Nom du classeur actuel
  strWB = ThisWorkbook.Name
  lgDerLig = 2
  ' Récupération du premier fichier dans le répertoire et sous repertoire
  VPath = ThisWorkbook.Path & "\SousRepertoire\"
  strFile = Dir(VPath & "*.xls")
  ' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
  Do While strFile <> ""
    ' Si le classeur n'est pas "Total.xls" et si son nom n'existe pas en colonne C
    If strFile <> strWB And Worksheets("Feuil1").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
      ' Ouvrir le fichier
      Workbooks.Open VPath & strFile
      ' Sélectionner le 1er onglet
      ActiveWorkbook.Worksheets(1).Activate
      ' Copier la sélection dans le classeur
      Worksheets(1).Range("A13:B28").Copy Destination:=Workbooks(strWB).Worksheets("Feuil1").Range("A" & lgDerLig)
      Workbooks(strWB).Worksheets("Feuil1").Range("C" & lgDerLig) = strFile
      lgDerLig = lgDerLig + 16  'il me semble, puique la hauteur copiée est de 16...
      ' Fermeture du classeur
      Workbooks(strFile).Close
    End If
    ' Classeur suivant
    strFile = Dir
  Loop
  MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub

A+
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Re : macro fonctionnant dans les sous-répertoire

Bonjour à tous,

merci cependant cette macro ne fonctionne pas, en fait je veux stocker mon fichier mère n'importe où sur le DD et qu'il me récupère les données dans les multiples sous-répertoire (dont le nombre peut augmenter) du répertoire D:\Documents and Settings\fl\Bureau\excel (qui existe bien)

merci de votre aide
 
Vote positif 0 Vote négatif
Re : macro fonctionnant dans les sous-répertoire

Bonjour
Si je ne me trompe pas,
supprime les lignes que j'ai mis entre deux /
et ajoute celles que j'ai mise entre []

Private Sub cmdRecupere_Click()
Dim intFile As Integer
Dim strWB As String
Dim strFile As String
Dim lgDerLig As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

' Nom du classeur actuel
strWB = ThisWorkbook.Name

lgDerLig = 2

[chemin="D:\Documents and Settings\fl\Bureau\excel" & "\SousRepertoire\"]

' Récupération du premier fichier dans le répertoire et sous repertoire

/strFile = Dir(ThisWorkbook.Path & "\SousRepertoire\*.xls")/
[strFile = Dir(chemin & "*.xls")]

' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls" et si son nom n'existe pas en colonne C
If strFile <> strWB And Worksheets("Feuil1").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' Ouvrir le fichier

/Workbooks.Open ThisWorkbook.Path & "\" & strFile/
[workbooks.open chemin & srtfile]

' Sélectionner le 1er onglet
ActiveWorkbook.Worksheets(1).Activate
' Copier la sélection dans le classeur
Worksheets(1).Range("A13:B28").Copy Destination:=Workbooks(strWB).Worksheets("Feuil1") .Range("A" & lgDerLig)
Workbooks(strWB).Worksheets("Feuil1").Range("C" & lgDerLig) = strFile
lgDerLig = lgDerLig + 16 'il me semble, puique la hauteur copiée est de 16...

' Fermeture du classeur
Workbooks(strFile).Close
End If

' Classeur suivant
strFile = Dir
Loop

MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 
Vote positif 0 Vote négatif
Re : macro fonctionnant dans les sous-répertoire

Re les amis,

cette macro ne fonctionne toujours pas, je suis pas sur que & "\SousRepertoire\" sélectionne tous les sous-répertoires de D:\Documents and Settings\flechiar\Bureau\testlist\test\ d'autant plus que le nombre de répertoire peut augmenter

Merci beaucoup


Private Sub cmdRecupere_Click()
Dim intFile As Integer
Dim strWB As String
Dim strFile As String
Dim lgDerLig As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

' Nom du classeur actuel
strWB = ThisWorkbook.Name

lgDerLig = 2

chemin = "D:\Documents and Settings\flechiar\Bureau\testlist\test\" & "\SousRepertoire\"

' Récupération du premier fichier dans le répertoire et sous repertoire
strFile = Dir(chemin & "*.xls")

' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls" et si son nom n'existe pas en colonne C
If strFile <> strWB And Worksheets("Feuil1").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' Ouvrir le fichier
Workbooks.Open chemin & srtfile

' Sélectionner le 1er onglet
ActiveWorkbook.Worksheets(1).Activate
' Copier la sélection dans le classeur
Worksheets(1).Range("A13:B28").Copy Destination:=Workbooks(strWB).Worksheets("Feuil1").Range("A" & lgDerLig)
Workbooks(strWB).Worksheets("Feuil1").Range("C" & lgDerLig) = strFile
lgDerLig = lgDerLig + 16 'il me semble, puique la hauteur copiée est de 16...

' Fermeture du classeur
Workbooks(strFile).Close
End If

' Classeur suivant
strFile = Dir
Loop

MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 
Vote positif 0 Vote négatif
Re : macro fonctionnant dans les sous-répertoire

Bonjour flosauveur69 et tous,
tu vas ma trouver pénible mais tout ton souci est dans le chemin
alors quand tu mets Excel\ sous répertoire c'est que tu as un dossier Sous répertoire !!!!!!!!!!!!!
Pour connaître ton chemin, celui qu'il faut donner à ta macro
tu vas dans un des fichiers que tu souhaites ouvrir, et là tu tapes
Code: 
sub info()
Msgbox thisworkbook.path
end sub
Et là tu auras le chemin qu'il faut donner à ta macro pour chercher les autres fichiers
a+
Papou 🙂
 
Vote positif 0 Vote négatif
Re : macro fonctionnant dans les sous-répertoire

je vous met une impression écran de mon répertoire avec ses 2 sous répertoire : test1 et test2

merci
 

Pièces jointes

  • Sans titre.JPG
    23.7 KB · Affichages: 63
  • Sans titre.JPG
    23.7 KB · Affichages: 67
  • Sans titre.JPG
    23.7 KB · Affichages: 69
Vote positif 0 Vote négatif
Re : macro fonctionnant dans les sous-répertoire

re bonjour à tous

Ci_dessous une méthode pour sélectionner tous lesz fichiers de tous les répertoires
à Toi de l'adapter




Sub deb()
Dim reps As New Collection

'ici définis le chemin exact pour accéder à tes fichier
chemin = ThisWorkbook.Path & "\test\"
'------------------------------------------------
rep = Dir(chemin, vbDirectory)
While rep <> ""
reps.Add rep
rep = Dir()
Wend

For Each rep In reps
If rep <> "." And rep <> ".." Then
fich = Dir(chemin & rep & "\")
While fich <> ""
Call traitement(fich)
fich = Dir()
Wend
End If
Next
End Sub

Sub traitement(f)
MsgBox f
End Sub
 
Vote positif 0 Vote négatif
Re : macro fonctionnant dans les sous-répertoire

Re,

alors les fichiers sont soit dans les sous-répertoire test1 et test2 soit dans des sous- sous répertoire dans test1 et test2, il y en a de partout je sais, mais ce n'est pas moi qui gère cela, c'est une copie d'un dossier qui est sur le réseau de mon entreprise.
De plus, il se peut qu'il y ai d'autres sous répertoire que test1 et test2 qui apparaisse dans test.

Merci d'avance pour ton aide
 
Vote positif 0 Vote négatif
Re : macro fonctionnant dans les sous-répertoire


Je te remercie vivement et te dis si j'ai des soucis. Par contre je suppose que je dois mettre ce bout de code dans la même feuille que ma macro et avant?
 
Vote positif 0 Vote négatif
Re : macro fonctionnant dans les sous-répertoire

Bonjour,

je viens déterrer ce topic, car je ne récupère plus les mêmes données ni dans le même répertoire mais j`ai toujours ce même problème donc je préfère ne pas créer un nouveau topic.

J`ai la macro suivante avec lesquels je veux récupérer les données de fichiers html qui sont dans le même répertoire que mon classeur Excel. Jusque-là cela fonctionne par contre je n`arrive pas a récupérer les données qui sont dans les sous répertoire car il y des fichier html aussi dans les sous répertoire. Autre problème, les sous répertoire ne sont pas figés et il peut y en avoir des nouveaux.

Je vous mets mon arborescence en PJ.

Merci d`avance.


Public Sub cmdRecupere_Click()
Dim strWB As String, strFile As String

Application.ScreenUpdating = False
Application.EnableEvents = False

' Nom du classeur actuel
strWB = ThisWorkbook.Name

' Récupération du premier fichier dans le répertoire et sous repertoire
strFile = Dir(ThisWorkbook.Path & "\*.html")

' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls" et si son nom n'existe pas en colonne C
If strFile <> strWB And Worksheets("AV_AP_DVR1").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & "\" & strFile

' Copie des données
Workbooks(strFile).Worksheets(1).Range("A13:C28").Copy
With Workbooks(strWB).Worksheets("AV_AP_DVR1")
.Range("A2").Insert xlDown 'insertion en ligne 2
.Range("c2:c17").ClearContents 'on ne garde que les données A2:B17
.Range("C2") = strFile
End With

' Fermeture du classeur
Workbooks(strFile).Close
End If

' Classeur suivant
strFile = Dir
Loop

Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."
End Sub
 

Pièces jointes

  • repertoire.JPG
    42.8 KB · Affichages: 69
Vote positif 0 Vote négatif
Re : macro fonctionnant dans les sous-répertoire

Bonjour Flosauveur69

Le code ne traite pas la redondance des sous-répertoires,
effectue une recherche sur le forum à ce sujet

A+
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

S
  • Résolu(e)
XL 2016 Coller nom classeur sur plage cellules
Réponses
9
Affichages
236
safranien
S
A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
629
arnoldbrice19
A
  • Résolu(e)
XL 2019 Erreur dans ma macro
Réponses
9
Affichages
596
Nadou69
A
  • Question Question
XL 2016 Boucle sur sous répertoire fso.GetFolder SharePoint
Réponses
0
Affichages
916
Aldonanou
A
F
  • Résolu(e)
XL 2019 Enregistrer sous la feuille active dans répertoire du fichier père en vba
2
Réponses
23
Affichages
2 K
Fabrice16ct
F
E
  • Résolu(e)
XL 2013 Rechercher et modifier la valeur d'une cellule dans tout un classeur
2
Réponses
21
Affichages
3 K
EXCJPH
E
C
  • Question Question
Microsoft 365 enregistrer sous vba un classeur avec valeur cellule et non sur le lien
Réponses
3
Affichages
1 K
Chapichapo
C
A
  • Question Question
Microsoft 365 VBA: importer dans un dossier avec un nom variable
Réponses
4
Affichages
974
A-F
A
E
  • Question Question
XL 2019 lister les classeurs dans un dossier et sous dossiers et cherche mots clés dans chaque feuille
Réponses
1
Affichages
564
Hasco
A
  • Question Question
XL 2010 Date dans fichier pour impression pdf
Réponses
2
Affichages
989
Aldonanou
A
  • Question Question
Microsoft 365 Macro .XLA découpage de fichiers à passer en X64
Réponses
8
Affichages
791
GADENSEB
O
  • Question Question
XL 2019 Copier dossier avec sous dossier
Réponses
2
Affichages
739
Olympe46
O
R
  • Question Question
XL 2010 VBA : consolidation
Réponses
2
Affichages
892
Rousseau Benoit
R
Rechercher des termes dans le code VBA de tous les classeurs d'un répertoire [Supprimé]
Réponses
1
Affichages
379
Dudu2
S
  • Question Question
Aide sur La fin d'une Macro SVP
Réponses
3
Affichages
759
sylvanu
A
  • Question Question
XL 2013 Macro pour copier des colonne d'une feuille A dans un classeur sur une feuille B dans un autre classeur .
Réponses
7
Affichages
1 K
Hasco
T
  • Résolu(e)
XL 2019 Changement de chemin
Réponses
10
Affichages
1 K
ChTi160
Rechercher des termes / mots dans le code VBA de tous les classeurs d'un répertoire
2
Réponses
15
Affichages
1 K
Dudu2
C
  • Résolu(e)
XL 2013 VBA : Erreur 1004
Réponses
2
Affichages
1 K
clarouche33
C
B
  • Question Question
XL 2019 Macros renommer plusieurs feuilles de plusieurs fichiers Excel
Réponses
3
Affichages
2 K
Bastien43
B
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…