Sujet Précédent Sujet Suivant

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

' 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

Réponse 1 / 3
LePierre Messages postés 249 Date d'inscription samedi 8 mars 2008 Statut Membre Dernière intervention 2 août 2012 337
28 juil. 2012 à 19:49
Bonjour

Ajoute : 

ChDrive "G:\"
avant ton Chdir ...
Bonne soirée
0
Réponse 2 / 3
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
@LePierre

Merci. Malheureusement ça ne marche pas mieux
0
Réponse 3 / 3
LePierre Messages postés 249 Date d'inscription samedi 8 mars 2008 Statut Membre Dernière intervention 2 août 2012 337
31 juil. 2012 à 09:02
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
0
LePierre Messages postés 249 Date d'inscription samedi 8 mars 2008 Statut Membre Dernière intervention 2 août 2012 337
2 août 2012 à 16:47
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
0

Discussions similaires

"L'indice n'appartient à la sélection" + VBA
fleur.31 -
geosevda -

2 réponses
VBA : Range avec références variables..
Antoine -
MIKE59 -

7 réponses
VBA erreur 1004
séverine -
Floroan -

9 réponses
ouverture d'un fichier excel à partir d'un code VBA
TraderAS -
pijaku -

3 réponses
Méthode find dans VBA - Recherche de données sous Excel
baissaoui -
baissaoui -

0 réponse