VBA : pb boucle de dossiers excel
vbauser92
Messages postés
2
Statut
Membre
-
LePierre Messages postés 249 Statut Membre -
LePierre Messages postés 249 Statut Membre -
Bonjour,
Je suis en train de faire un bout de code pour récupérer dans un même classeur des reportings individuels saisis pour chacun dans un classeur différent (dans le sous-répertoire Reportings). Et j'ai visiblement des problèmes avec l'ouverture ou l'activation avec les arborescence précisées. Pouvez-vous me dépanner ? Je pense qu'il y a un problème dû au fait que le classeur de consolidation (Détail_Pilotage_CONSO.xlms)est dans un autre répertoire, mais je ne m'en sors pas.
Merci d'avance
Je suis en train de faire un bout de code pour récupérer dans un même classeur des reportings individuels saisis pour chacun dans un classeur différent (dans le sous-répertoire Reportings). Et j'ai visiblement des problèmes avec l'ouverture ou l'activation avec les arborescence précisées. Pouvez-vous me dépanner ? Je pense qu'il y a un problème dû au fait que le classeur de consolidation (Détail_Pilotage_CONSO.xlms)est dans un autre répertoire, mais je ne m'en sors pas.
' Placement dans le répertoire des reportings individuels
ChDir "G:\Missions\Reporting DIR\Reportings"
ClasseurPersonnel = Dir("G:\Missions\Reporting DIR\Reportings\*.xlsx")
While Len(ClasseurPersonnel) > 0
Workbooks.Open ClasseurPersonnel
DerniereLigne = ActiveSheet.UsedRange.Rows.Count
ActiveSheet.Range("A7:AB" & DerniereLigne).Copy
Workbooks("G:\Missions\Reporting DIR\Détail_Pilotage_CONSO.xlsm").Activate
DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
ActiveSheet.Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
ActiveSheet.Paste
Range("AC" & DebutNomFichier & ":AC" & ActiveSheet.UsedRange.Rows.Count) = ClasseurPersonnel
Workbooks(ClasseurPersonnel).Close
ClasseurPersonnel = Dir
Wend
Merci d'avance
3 réponses
-
Bonjour
Ajoute :
ChDrive "G:\"
avant ton Chdir ...
Bonne soirée -
-
Bonjour
Essaye ceci :Sub Essai_vbauser92() ChDrive "G:\" Workbooks.Open "G:\Missions\Reporting DIR\Détail_Pilotage_CONSO.xlsm" ChDir "G:\Missions\Reporting DIR\Reportings" ClasseurPersonnel = Dir("G:\Missions\Reporting DIR\Reportings\*.xlsx") While Len(ClasseurPersonnel) > 0 If ClasseurPersonnel <> "Détail_Pilotage_CONSO.xlsm" Then Workbooks.Open ClasseurPersonnel DerniereLigne = ActiveSheet.UsedRange.Rows.Count ActiveSheet.Range("A7:AB" & DerniereLigne).Copy Windows("Détail_Pilotage_CONSO.xls").Activate DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1 ActiveSheet.Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select ActiveSheet.Paste Range("AC" & DebutNomFichier & ":AC" & ActiveSheet.UsedRange.Rows.Count) = ClasseurPersonnel Workbooks(ClasseurPersonnel).Close ClasseurPersonnel = Dir End If Wend End Sub
à plus-
Bonjour
Voici une nouvelle version testée et fonctionnelle :Sub Essai_vbauser92_2() ClasseurPrincipal = ActiveWorkbook.Name ' "Détail_Pilotage_CONSO.xlsm" Chemin = "G:\Missions\Reporting DIR\Reportings\" Application.ScreenUpdating = False ClasseurPersonnel = Dir(Chemin & "*.xls?") While Len(ClasseurPersonnel) > 0 If ClasseurPersonnel <> ClasseurPrincipal Then Workbooks.Open ClasseurPersonnel DerniereLigne = ActiveSheet.Range("A65536").End(xlUp).Row ActiveSheet.Range("A7:AB" & DerniereLigne).Copy Windows(ClasseurPrincipal).Activate DerLig = ActiveSheet.Range("A65536").End(xlUp).Row Cells(DerLig + 1, 1).Value = ClasseurPersonnel Cells(DerLig + 2, 1).Select ActiveSheet.Paste Application.CutCopyMode = False 'Application.DisplayAlerts = False Workbooks(ClasseurPersonnel).Close 'Application.DisplayAlerts = True End If ClasseurPersonnel = Dir Wend Cells(1, 1).Select Application.ScreenUpdating = True End Sub
j'espère que cela te conviendra.
à plus
-
