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