[VBA] Boucle en VBA

nat54

nat54

XLDnaute Barbatruc
Bonjour,

J'ai finalisé mon code VBA qui marche pour un pôle en question (un des 31 fichiers tableau de bord)

Ci-dessous le code :

Code: 
Sub Construire_fichiers()
 
 
    ''' Test sur pôle 3945 (à voir plus tard pour une boucle)
    Workbooks.Open Filename:= _
    "R:\ECHANGE\Tableau_de_bord_RH\3945 - PEDIATRIE\TdB_RH_3945_année_2011-2012.xls", _
    WriteResPassword:="wxcvbn", _
    IgnoreReadOnlyRecommended:=True
 
       
    ''' Déprotéger classeur
    Application.Run "'TdB_RH_3945_année_2011-2012.xls'!DeProtegeClasseur"
   
   
    ''' Rendre visible les onglets d'export
    Windows("TdB_RH_3945_année_2011-2012.xls").Activate
    Sheets("export_HUS_abs").Visible = True
    Sheets("export_HUS_gestor").Visible = True
    Sheets("export_abs_N-1").Visible = True
    Sheets("export_gestor_N-1").Visible = True
   
    ''' Pour moyenne absentéisme HUS
    Sheets("export_HUS_abs").Select
    Range("a2:u" & Range("u65536").End(xlUp).Offset(1, 0).Row).Select
    Selection.ClearContents
    Windows("Export_BO_ABS_HUS.xls").Activate
    Range("a1:u" & Range("u65536").End(xlUp).Offset(1, 0).Row).Select
    Selection.Copy
    Windows("TdB_RH_3945_année_2011-2012.xls").Activate
    Sheets("export_HUS_abs").Select
    Range("A65536").End(xlUp).Select
    ActiveSheet.Paste
   
   
    ''' Pour moyenne gestor HUS
    Windows("Export_BO_GESTOR_HUS.xls").Activate
    Range("a1:k" & Range("k65536").End(xlUp).Offset(0, 0).Row).Select
    Selection.Copy
    Windows("TdB_RH_3945_année_2011-2012.xls").Activate
    Sheets("export_HUS_gestor").Select
    Range("A65536").End(xlUp).Select
    ActiveSheet.Paste
   
  
    ''' Pour absentéisme du pôle test 3945 (à voir pour une boucle plus tard)
    Windows("TdB_RH_3945_année_2011-2012.xls").Activate
    Sheets("export_abs").Select
    Range("a2:ad" & Range("ad65536").End(xlUp).Offset(1, 0).Row).Select
    Selection.ClearContents
    Windows("Export_BO_ABS_nominatif.xls").Activate
    Selection.AutoFilter Field:=4, Criteria1:="3945"  'field 4 = colonne D, pôle 3945
    Range("a2:ad10000").Select
    Selection.Copy
    Windows("TdB_RH_3945_année_2011-2012.xls").Activate
    Sheets("export_abs").Select
    Range("a2:ad" & Range("ad65536").End(xlUp).Offset(1, 0).Row).Select
    ActiveSheet.Paste
 
   
   
     ''' Pour gestor du pôle test 3945 (à voir pour une boucle plus tard)
    Windows("Export_BO_GESTOR_nominatif.xls").Activate
    Selection.AutoFilter Field:=5, Criteria1:="3945"  'field 5 = colonne E, pôle 3945
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("TdB_RH_3945_année_2011-2012.xls").Activate
    Sheets("export_gestor").Select
    x = Selection.Rows.Count + 2 '+1 si pas de ligne de titre, +2 si ligne de titre
    Range("A" & x).Select
    ActiveSheet.Paste
       
 
    ''' Reprotéger classeur
    Application.Run "'TdB_RH_3945_année_2011-2012.xls'!ProtegeClasseur"
   
   
    ''' Masquer les onglets export HUS (gestor et abs), export N-1 (gestor et abs)
    Sheets("export_HUS_abs").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("export_HUS_gestor").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("export_abs_N-1").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("export_gestor_N-1").Select
    ActiveWindow.SelectedSheets.Visible = False
   
     
    ''' Sauvegarder le TdB RH
    ActiveWorkbook.Close True 'true = sauvegarde les changements
 
 
    ''' Fermer les classeurs d'export
    Windows("Export_BO_ABS_HUS.xls").Activate
    ActiveWorkbook.Close False
    Windows("Export_BO_GESTOR_HUS.xls").Activate
    ActiveWorkbook.Close False
    Windows("Export_BO_ABS_nominatif.xls").Activate
    ActiveWorkbook.Close False
    Windows("Export_BO_GESTOR_nominatif.xls").Activate
    ActiveWorkbook.Close False
 
End Sub






Le code fonctionne parfaitement.

J'aimerai donc pouvoir maintenant "boucler" pour faire tous les fichiers en une fois.
Chaque fichier est nommé de la même manière : TdB_RH_3945_année_2011-2012.xls
où 3945 correspond au numéro du pôle.

Toutes les actions doivent se faire sur chacun des pôles.
Le prochain à traiter est le 3580.

Y a t'il moyen de variabiliser cela ?

Contrainte supplémentaire : le chemin d'accès au fichier ... :(
- le pôle 3945 se situe dans le répertoire R:\ECHANGE\Tableau_de_bord_RH\3945 - PEDIATRIE
- le pôle 3580 se situe dans le répertoire R:\ECHANGE\Tableau_de_bord_RH\3580 - ODONTOLOGIE
Y a t il moyen de trouver le chemin en disant quelque chose du genre "contient 3580" ?


Merci d'avance !


edit : je voulais mettre en couleur les endroits à variabiliser mais ça fait planter les balises code du forum...

edit 2 : le synopsis si ça peut aider.. quoique.. :d
http://www.heberger-image.frhttp://www.heberger-image.fr
 
Dernière édition:
Trier par date Trier par votes
V

Vorens

XLDnaute Occasionnel
Re : [VBA] Boucle en VBA

Re,

Surement que tu as une ligne .activate sur un autre classeur dans ton code alors lorsque tu repasse sur cette ligne de code sans préciser le Workbook il prend le dernier activer et si le dernier activé n'est pas le bon workbook et que la feuille Mapping n'existe pas alors tu obtient cette erreur.

Lorsque tu manipule plusieur classeur, précise Workbooks sur ta ligne afin d'éviter cette erreur.

Cela donne un truc comme sa

Code: 
FichierTraite = Workbooks("Fichieroucetrouvelafeuille").Sheets("Mapping").Range("A" & i).Value

Meilleures salutations
 
Vote positif 0 Vote négatif
nat54

nat54

XLDnaute Barbatruc
Re : [VBA] Boucle en VBA

Re,

Merci

Je m'approche du bout

Code: 
Sub Construire_fichiers()
    ''' Boucle sur l'onglet Mapping
    FinTableauMapping = Sheets("Mapping").Range("A" & "65535").End(xlUp).Row
    For i = 2 To FinTableauMapping
    FichierTraite = Workbooks("Macro_TdB_RH_automatisé.xls").Sheets("Mapping").Range("A" & i).Value
    PathFichier = Workbooks("Macro_TdB_RH_automatisé.xls").Sheets("Mapping").Range("B" & i) & FichierTraite
    CodePole = Workbooks("Macro_TdB_RH_automatisé.xls").Sheets("Mapping").Range("c" & i).Value
    Dim F_CurrentCata As Workbook
    Application.DisplayAlerts = False
    Set F_CurrentCata = Workbooks.Open(PathFichier)
    ''' Test sur pôle 3945 (à voir plus tard pour une boucle)
    'Workbooks.Open Filename:= _
    '"R:\ECHANGE\Tableau_de_bord_RH\3945 - PEDIATRIE\TdB_RH_3945_année_2011-2012.xls", _
    'WriteResPassword:="wxcvbn", _
    'IgnoreReadOnlyRecommended:=True
        
    ''' Déprotéger classeur
   Application.Run "'" & FichierTraite & "'!DeProtegeClasseur"
   
    
    ''' Rendre visible les onglets d'export
    With Workbooks(FichierTraite)
        .Sheets("export_HUS_abs").Visible = True
        .Sheets("export_HUS_gestor").Visible = True
        .Sheets("export_abs_N-1").Visible = True
        .Sheets("export_gestor_N-1").Visible = True
    End With
    
    ''' Pour moyenne absentéisme HUS
    Sheets("export_HUS_abs").Select
    Range("a2:u" & Range("u65536").End(xlUp).Offset(1, 0).Row).Select
    Selection.ClearContents
    Windows("Export_BO_ABS_HUS.xls").Activate
    Range("a1:u" & Range("u65536").End(xlUp).Offset(1, 0).Row).Select
    Selection.Copy
    Windows(FichierTraite).Activate
    Sheets("export_HUS_abs").Select
    Range("A65536").End(xlUp).Select
    ActiveSheet.Paste
    
    
    ''' Pour moyenne gestor HUS
    Windows("Export_BO_GESTOR_HUS.xls").Activate
    Range("a1:k" & Range("k65536").End(xlUp).Offset(0, 0).Row).Select
    Selection.Copy
    Windows(FichierTraite).Activate
    Sheets("export_HUS_gestor").Select
    Range("A65536").End(xlUp).Select
    ActiveSheet.Paste
    
   
    ''' Pour absentéisme du pôle test 3945 (à voir pour une boucle plus tard)
    Windows(FichierTraite).Activate
    Sheets("export_abs").Select
    Range("a2:ad" & Range("ad65536").End(xlUp).Offset(1, 0).Row).Select
    Selection.ClearContents
    Windows("Export_BO_ABS_nominatif.xls").Activate
    Selection.AutoFilter Field:=4, Criteria1:=CodePole  'field 4 = colonne D, pôle 3945
    Range("a2:ad10000").Select
    Selection.Copy
    Windows(FichierTraite).Activate
    Sheets("export_abs").Select
    Range("a2:ad" & Range("ad65536").End(xlUp).Offset(1, 0).Row).Select
    ActiveSheet.Paste
    
    
     ''' Pour gestor du pôle test 3945 (à voir pour une boucle plus tard)
    Windows("Export_BO_GESTOR_nominatif.xls").Activate
    Selection.AutoFilter Field:=5, Criteria1:=CodePole  'field 5 = colonne E, pôle 3945
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows(FichierTraite).Activate
    Sheets("export_gestor").Select
    x = Selection.Rows.Count + 2 '+1 si pas de ligne de titre, +2 si ligne de titre
    Range("A" & x).Select
    ActiveSheet.Paste
        
  
    ''' Reprotéger classeur
    Application.Run "'" & FichierTraite & "'!ProtegeClasseur"
    
    
    ''' Masquer les onglets export HUS (gestor et abs), export N-1 (gestor et abs)
    Sheets("export_HUS_abs").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("export_HUS_gestor").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("export_abs_N-1").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("export_gestor_N-1").Select
    ActiveWindow.SelectedSheets.Visible = False
    
      
    ''' Sauvegarder le TdB RH
    ActiveWorkbook.Close True 'true = sauvegarde les changements
 
    ''' On passe au pôle suivant
    Next
    
    
    ''' Fermer les classeurs d'export
    Windows("Export_BO_ABS_HUS.xls").Activate
    ActiveWorkbook.Close False
    Windows("Export_BO_GESTOR_HUS.xls").Activate
    ActiveWorkbook.Close False
    Windows("Export_BO_ABS_nominatif.xls").Activate
    ActiveWorkbook.Close False
    Windows("Export_BO_GESTOR_nominatif.xls").Activate
    ActiveWorkbook.Close False
End Sub


Les soucis restants :

  1. d'un mois sur l'autre je lancerais la macro pour intégrer les nouvelles données
Aucun souci pour les export HUS qui écrasent les anciennes données
Un seul export doit être collé à la suite de l'export du/des mois précédent(s)

Et ça bug car ça colle sur la dernière ligne de l'export précédent, qui devient alors incomplet
Code: 
Windows("Export_BO_GESTOR_nominatif.xls").Activate
    Selection.AutoFilter Field:=5, Criteria1:=CodePole  'field 5 = colonne E, pôle 3945
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows(FichierTraite).Activate
    Sheets("export_gestor").Select
    x = Selection.Rows.Count + 2 '+1 si pas de ligne de titre, +2 si ligne de titre
    Range("A" & x).Select
    ActiveSheet.Paste

2. Comment réintégrer le fait de ne pas avoir à saisir le mot de passe de lecture seule dans la variable FichierTraite ?
Avant
Code: 
'"R:\ECHANGE\Tableau_de_bord_RH\3945 - PEDIATRIE\TdB_RH_3945_année_2011-2012.xls", _
    'WriteResPassword:="wxcvbn", _
    'IgnoreReadOnlyRecommended:=True
fonctionnait


A cela je rajouterai une cerise sur le gâteau s'il le faut :)
 
Vote positif 0 Vote négatif
nat54

nat54

XLDnaute Barbatruc
Re : [VBA] Boucle en VBA

Ca ne marchait pas mais je m'en suis inspirée et ça donne
Code: 
Range("A" & Range("a65536").End(xlUp).Offset(1, 0).Row).Select

Je m'attaque au mot de passe lecture seule
que je veux éviter de saisir (31 fois) ici
Code: 
F_CurrentCata = Workbooks.Open(PathFichier)
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
XL 2016 Interférence entre une boucle et un copie de feuille
Réponses
4
Affichages
364
Oneida
Oneida
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
132
marie3107
M
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
1 K
thivame
T
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
567
mouchtre
mouchtre
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
380
M@xu3L
M
C
  • Question
Microsoft 365 Arret macro si condition est fausse
Réponses
4
Affichages
402
Chounoé
C
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
190
marie3107
M
X
  • Question
XL 2016 Copier à partir de la dernière ligne renseignée.
Réponses
8
Affichages
452
Xender
X
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
102
Latias
L
A
  • Résolu(e)
XL 2016 Autofill Destination sur colonne adjacente
Réponses
3
Affichages
369
Aldonanou
A

Membres actuellement en ligne

9 membres et 83 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 390
Messages
2 087 938
Membres
103 679
dernier inscrit
yprivey3