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
A voir également:
- VBA : pb boucle de dossiers excel
- Excel compter cellule couleur sans vba - Guide
- Incompatibilité de type vba ✓ - Forum VB / VBA
- Erreur 13 incompatibilité de type VBA excel ✓ - Forum Excel
- Find vba - Astuces et Solutions
- Vba range avec variable ✓ - Forum VB / VBA
3 réponses
Bonjour
Essaye ceci :
à plus
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 :
j'espère que cela te conviendra.
à plus
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
