VBA : pb boucle de dossiers excel
Fermé
vbauser92
Messages postés
2
Date d'inscription
vendredi 27 juillet 2012
Statut
Membre
Dernière intervention
30 juillet 2012
-
27 juil. 2012 à 15:27
LePierre Messages postés 249 Date d'inscription samedi 8 mars 2008 Statut Membre Dernière intervention 2 août 2012 - 2 août 2012 à 16:47
LePierre Messages postés 249 Date d'inscription samedi 8 mars 2008 Statut Membre Dernière intervention 2 août 2012 - 2 août 2012 à 16:47
A voir également:
- VBA : pb boucle de dossiers excel
- Mkdir vba ✓ - Forum VB / VBA
- Vba récupérer valeur cellule ✓ - Forum VB / VBA
- Excel compter cellule couleur sans vba - Guide
- Vba range avec variable ✓ - Forum VB / VBA
- Autofill vba ✓ - Forum Excel
3 réponses
LePierre
Messages postés
249
Date d'inscription
samedi 8 mars 2008
Statut
Membre
Dernière intervention
2 août 2012
338
28 juil. 2012 à 19:49
28 juil. 2012 à 19:49
Bonjour
Ajoute :
Bonne soirée
Ajoute :
ChDrive "G:\"avant ton Chdir ...
Bonne soirée
vbauser92
Messages postés
2
Date d'inscription
vendredi 27 juillet 2012
Statut
Membre
Dernière intervention
30 juillet 2012
30 juil. 2012 à 13:36
30 juil. 2012 à 13:36
@LePierre
Merci. Malheureusement ça ne marche pas mieux
Merci. Malheureusement ça ne marche pas mieux
LePierre
Messages postés
249
Date d'inscription
samedi 8 mars 2008
Statut
Membre
Dernière intervention
2 août 2012
338
31 juil. 2012 à 09:02
31 juil. 2012 à 09:02
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
LePierre
Messages postés
249
Date d'inscription
samedi 8 mars 2008
Statut
Membre
Dernière intervention
2 août 2012
338
2 août 2012 à 16:47
2 août 2012 à 16:47
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
