bonsoir le forum
je me permets de vous faire appel pour un petit pb concernant la synthese de plusieurs fichiers excel se trouvant dans plusieurs dossiers et sous dossiers
mon code fonctionne si tous les fichiers excel sont sous c: et dans un même dossier
voici le code
Sub consolide()
ChDir ActiveWorkbook.Path
Set recap = ActiveWorkbook
compteur = 1
nf = Dir("*RESULTAT.xls")
Do While nf <> ""
If nf <> recap.Name Then
Workbooks.Open Filename:=nf
For t = 54 To 63
recap.Sheets(5).Cells(compteur, 1) = Workbooks(nf).Sheets("SXB").Range("e" & t).Value
recap.Sheets(5).Cells(compteur, 2) = Workbooks(nf).Sheets("SXB").Range("f" & t).Value
recap.Sheets(5).Cells(compteur, 3) = Workbooks(nf).Sheets("SXB").Range("i" & t).Value
recap.Sheets(5).Cells(compteur, 4) = Workbooks(nf).Sheets("SXB").Range("l" & t).Value
recap.Sheets(5).Cells(compteur, 5) = Workbooks(nf).Sheets("SXB").Range("m" & t).Value
compteur = compteur + 1
Next
Workbooks(nf).Close False
End If
nf = Dir
Loop
End Sub
---------
par contre je souhaite importer des donnees de plusieurs dossiers et sous dossiers et dans ce cas le code ne fonctionne plus
j'ai tenté de développer un bout de code mais j'ai un bug
Dim classeurMaitre
Sub consoldateAborescence()
Application.ScreenUpdating = False
classeurMaitre = ThisWorkbook.Name
repertoire = ThisWorkbook.Path
Set fs = CreateObject("scripting.filesystemobject")
Set dossierRacine = fs.getfolder(repertoire)
lit_dossier dossierRacine, 1
End Sub
Sub lit_dossier(ByRef dossier, ByVal niveau)
For Each d In dossier.subfolders
lit_dossier d, niveau + 1
Next
For Each f In dossier.Files
nf = f.Name
If nf <> classeurMaitre Then
Workbooks.Open Filename:=dossier & "\" & nf
compteur = 1
For t = 54 To 63
recap.Sheets(5).Cells(compteur, 1) = Workbooks(nf).Sheets("SXB").Range("e" & t).Value
' recap.Sheets(5).Cells(compteur, 2) = Workbooks(nf).Sheets("SXB").Range("f" & t).Value
' recap.Sheets(5).Cells(compteur, 3) = Workbooks(nf).Sheets("SXB").Range("i" & t).Value
' recap.Sheets(5).Cells(compteur, 4) = Workbooks(nf).Sheets("SXB").Range("l" & t).Value
' recap.Sheets(5).Cells(compteur, 5) = Workbooks(nf).Sheets("SXB").Range("m" & t).Value
compteur = compteur + 1
Next
ActiveWorkbook.Close False
End If
Next
End Sub
merci pour votre aide
je me permets de vous faire appel pour un petit pb concernant la synthese de plusieurs fichiers excel se trouvant dans plusieurs dossiers et sous dossiers
mon code fonctionne si tous les fichiers excel sont sous c: et dans un même dossier
voici le code
Sub consolide()
ChDir ActiveWorkbook.Path
Set recap = ActiveWorkbook
compteur = 1
nf = Dir("*RESULTAT.xls")
Do While nf <> ""
If nf <> recap.Name Then
Workbooks.Open Filename:=nf
For t = 54 To 63
recap.Sheets(5).Cells(compteur, 1) = Workbooks(nf).Sheets("SXB").Range("e" & t).Value
recap.Sheets(5).Cells(compteur, 2) = Workbooks(nf).Sheets("SXB").Range("f" & t).Value
recap.Sheets(5).Cells(compteur, 3) = Workbooks(nf).Sheets("SXB").Range("i" & t).Value
recap.Sheets(5).Cells(compteur, 4) = Workbooks(nf).Sheets("SXB").Range("l" & t).Value
recap.Sheets(5).Cells(compteur, 5) = Workbooks(nf).Sheets("SXB").Range("m" & t).Value
compteur = compteur + 1
Next
Workbooks(nf).Close False
End If
nf = Dir
Loop
End Sub
---------
par contre je souhaite importer des donnees de plusieurs dossiers et sous dossiers et dans ce cas le code ne fonctionne plus
j'ai tenté de développer un bout de code mais j'ai un bug
Dim classeurMaitre
Sub consoldateAborescence()
Application.ScreenUpdating = False
classeurMaitre = ThisWorkbook.Name
repertoire = ThisWorkbook.Path
Set fs = CreateObject("scripting.filesystemobject")
Set dossierRacine = fs.getfolder(repertoire)
lit_dossier dossierRacine, 1
End Sub
Sub lit_dossier(ByRef dossier, ByVal niveau)
For Each d In dossier.subfolders
lit_dossier d, niveau + 1
Next
For Each f In dossier.Files
nf = f.Name
If nf <> classeurMaitre Then
Workbooks.Open Filename:=dossier & "\" & nf
compteur = 1
For t = 54 To 63
recap.Sheets(5).Cells(compteur, 1) = Workbooks(nf).Sheets("SXB").Range("e" & t).Value
' recap.Sheets(5).Cells(compteur, 2) = Workbooks(nf).Sheets("SXB").Range("f" & t).Value
' recap.Sheets(5).Cells(compteur, 3) = Workbooks(nf).Sheets("SXB").Range("i" & t).Value
' recap.Sheets(5).Cells(compteur, 4) = Workbooks(nf).Sheets("SXB").Range("l" & t).Value
' recap.Sheets(5).Cells(compteur, 5) = Workbooks(nf).Sheets("SXB").Range("m" & t).Value
compteur = compteur + 1
Next
ActiveWorkbook.Close False
End If
Next
End Sub
merci pour votre aide
Pièces jointes
Dernière édition: