XL 2010 récupération de données dans plusieurs feuilles qui s'incrémente au fur et à mesure

[Fabensa]

Bonjour :
voici le contexte : j'ai un classeur avec différentes feuilles. Chaque feuille, portant un nom spécifique, représente 1 type de formation (7h,21h,56h,70h) avec une cellule de choix du type de formation; dans chacune des feuilles il y a des colonnes d'évaluation. L’évaluation se fait par un symbole dans une liste déroulante (ils sont au nombre 3 différents: 1 étoiles, 2 étoiles, 3 étoiles) et des commentaires. Enfin j'ai une feuille récapitulative des évaluations pour voir en un clin d'oeil l'ensemble des évaluations par colonnes sans les commentaires.
Ma question est la suivante : Comment récupérer l'ensemble des évaluations sur un feuille récap (donc des symboles selon les cellules) en les incrémentant à la chaine en fonction de l'ajout de feuille et selon le type de formation (7h,21h,56h,70h) avec le nom de la feuille inscrit en tête de colonne sachant que celui-ci est cliquable pour aller sur le détail de l'évaluation qui se trouve dans la feuille respective.
en gros ça devrait faire : si nouvelle feuille (nom de la feuille A) et si type = (7h,21h,56h,70h) alors en fonction de ces deux conditions, récupération du contenu de la colonne de telle cellule à telle cellule pour la mettre dans une feuille recap (7h,21h,56h,70h) dans une nouvelle colonne à la suite des autres nommée (nom de la feuille A avec lien cliquable) et le tout des l'ajout d'une feuille
Je ne sais pas si je suis clair, autre précision je fais du excel depuis..................................... aujourd'hui. Je mets le fichier en pièce jointe pour que ce soit plus clair.
Je vous remercie de votre aide.

 

[AtTheOne]

Bonjour à tous, bonjour @Fabensa

Après une petite reprise de la forme des feuilles (type 21H) voici une réponse à ta question.

Sub Récap()

     Select Case [A5]    'A5 : la cellule contenant la durée du stage
          Case "7H"
               'à développer
          Case "21H"
               Récap_21
          Case "56H"
               'à développer
          Case "76H"
               'à développer
     End Select
    
End Sub


Sub Récap_21()
    
     'Nom de la feuille Récap (Cible)
     Const Nom_Cible = "Recap 21H"
     'Colonne de la feuille cible contenant les formats à recopier
     Const Col_Modèle = 2
    
     'Plages de données Source pour les stages 21 heures
     Const S_Général_21 As String = "$B$8:$B$10"
     Const S_Jour1_21 As String = "$B$14:$B$22"
     Const S_Jour2_21 As String = "$B$26:$B$35"
     Const S_Jour3_21 As String = "$B$39:$B$42"
    
     'Plages de données Cibles pour les stages 21 heures (la 1ère colonne)
     Const C_L_Titre As Long = 6
     Const C_Général_21 As String = "$A$7:$A$9"
     Const C_Jour1_21 As String = "$A$11:$A$19"
     Const C_Jour2_21 As String = "$A$21:$A$30"
     Const C_Jour3_21 As String = "$A$32:$A$35"
    
     Dim Wsh_C As Worksheet, Wsh_S As Worksheet
     Set Wsh_C = ThisWorkbook.Worksheets(Nom_Cible)
    
     Set Wsh_S = ActiveSheet
     Nom_Promo = Wsh_S.Name
    
     Décalage = WorksheetFunction.CountA(Wsh_C.Rows(C_L_Titre))
    
     'Nom de la feuille source
     Wsh_C.Cells(C_L_Titre, Décalage + 1).Value = Nom_Promo
     'Lien hypertexte vers cette feuille
     Wsh_C.Hyperlinks.Add Anchor:=Wsh_C.Cells(C_L_Titre, Décalage + 1), Address:="", SubAddress:="'" & Nom_Promo & "'!A1", TextToDisplay:=Nom_Promo
    
     'Recopie des valeurs
     Wsh_C.Evaluate(C_Général_21).Offset(0, Décalage).Value = Wsh_S.Evaluate(S_Général_21).Value
     Wsh_C.Evaluate(C_Jour1_21).Offset(0, Décalage).Value = Wsh_S.Evaluate(S_Jour1_21).Value
     Wsh_C.Evaluate(C_Jour2_21).Offset(0, Décalage).Value = Wsh_S.Evaluate(S_Jour2_21).Value
     Wsh_C.Evaluate(C_Jour3_21).Offset(0, Décalage).Value = Wsh_S.Evaluate(S_Jour3_21).Value
    
     'Recopie des formats
     Wsh_C.Columns(Col_Modèle).Copy
     Wsh_C.Columns(Col_Modèle).Resize(, Décalage).PasteSpecial xlPasteFormats
    
     'Style Hypertexte
     Wsh_C.Cells(C_L_Titre, Col_Modèle).Offset(0, 1).Resize(, Décalage - 1).Style = "Hyperlink"
    
End Sub

Dans l'onglet Recap 21 j'ai ajouté une colonne pour afficher la moyenne des évaluations, on ne sait jamais...
Voir le fichier Joint

Amicalement
Alain

 

[Fabensa]

Merci AtTheOne mais il semble, sauf erreur de ma part, que cela ne fonctionne pas car la feuille Récap 21 h ne récupère pas les infos de la colonne B des feuilles Promo de 21H, et qu'il n'y ai pas d'incrémentation au fur et mesure que l'on ajoute des feuilles.

 

[Fabensa]

Alors sinon la réorganisation des cellules est une bonne idée et si je comprends bien, c'est en appuyant sur récap que ça "synchronise " les données c'est aussi une super idée. Merci attheone.

 

[AtTheOne]

Bonjour à tous, bonjour @Fabensa

Exactement, il faut cliquer sur le bouton Récap pour transférer les données dans la feuille de RECAP qui correspond. (le bouton est inclus dans l'onglet de base qui sert de modèle pour les onglets de retour)

Sinon on pourrait automatiser l'action à condition de savoir quelles feuilles importer dans l'onglet RECAP.
Par ex mettre un préfixe 21H- pour les stages de 21H, 7H- pour ceux de 7H etc., et faire la consolidation lors de l'activation de la feuille de récap en recherchant toutes les feuilles dont le nom commence par le préfixe en question et non encore prises en compte...

Je ne suis pas sûr que ce soit une meilleure solution.

Amicalement
Alain

 

[Fabensa]

Merci pour ton message cependant je t'ai fais une capture d'écran excel s'arrête en cour de route, je remet la photo il semble manquer une bibliothèque. sinon oui on peut tout à fait faire ainsi en mettant un préfixe 7H ou 21H ou 56H ou 70H. J'aime bien l'idée du bouton récap qui synchronise une fois que la feuille est finie. Tant que la feuille n'est pas finie il n'y a pas d'enregistrement.

 

[AtTheOne]

Re-Bonjour à tous,
Essaie cette version.
J'ai supprimé les deux modules (module1 et module2) qui étaient dans ton fichier initial et j'ai retiré les références qui me semblaient douteuses :

• Microsoft Outlook16 Object library (j'ai office 2021)
• Tabular Data Control 1.1 Type library (peut-être utilisée par un des module que j'ai supprimé ?)

Amicalement
Alain

 

[Fabensa]

C'est super merci beaucoup AtTheOne cela à l'air de fonctionner sur le 21H mille merci je vais essayer sur une base 7H, 56H, et 70H.
Je te tiens au courant
Amicalement

 

[Fabensa]

Petite question @AtTheOne je vais faire la feuille base 7H,56H,70H donc avec plus de trois jours donc plus de cellules, il me suffira de reproduire le programme en actualisant les différente plages de cellule et le nom des feuilles?

 

[AtTheOne]

Bonne nuit à tous, bonne nuit @Fabensa

il me suffira de reproduire le programme en actualisant les différente plages de cellule et le nom des feuilles?

Oui, c'est pour cela que lorsqu'il y a des références en dur dans mes codes je les mets dans des constantes (publiques ou non) en tête de code.
Bien sûr il te faudra recopier des lignes ou en supprimer pour s'adapter au nombre de jours des différents stages mais le principe reste le même.
J'aurais pu faire cela avec 2 array() contenant les adresses et là il n'y aurait eu qu'à modifier les 2 tableaux et le nom de la feuille mais ...
J'aurais même pu passer ces informations en argument de la procédure, mais ...

Si tu rencontres une difficulté, n'hésite pas...
Amicalement
Alain

 

[AtTheOne]

Re..

J'aurais même pu passer ces informations en argument de la procédure, mais ...

D'ailleurs je l'ai fait :

Sub Récap()

Dim Feuille, Source, Cible
     Select Case [A5]    'A5 : la cellule contenant la durée du stage
          Case "7H"
               'à développer
          Case "21H"
               Feuille = "Recap 21H"
               Source = Array("$B$8:$B$10", "$B$14:$B$22", "$B$26:$B$35", "$B$39:$B$42")
               Cible = Array("$A$7:$A$9", "$A$11:$A$19", "$A$21:$A$30", "$A$32:$A$35")
          Case "56H"
               'à développer
          Case "76H"
               'à développer
     End Select
    
     Consolider Feuille, Source, Cible
    
End Sub

Sub Consolider(Feuille, Source, Cible)
    
     Const C_L_Titre As Long = 6   'N° ligne d'entête dans la feuille cible
     Const Col_Modèle = 2          'N° de la colonne de la feuille cible contenant les formats à recopier (colonne Moyenne)
     Dim Wsh_C As Worksheet, Wsh_S As Worksheet
     Dim Nom_Promo As String, Décalage As Integer, i As Integer
    
     Application.ScreenUpdating = False
    
     Set Wsh_C = ThisWorkbook.Worksheets(Feuille)
    
     Set Wsh_S = ActiveSheet
     Nom_Promo = Wsh_S.Name
    
     Décalage = WorksheetFunction.CountA(Wsh_C.Rows(C_L_Titre))
    
     'Nom de la feuille source
     Wsh_C.Cells(C_L_Titre, Décalage + 1).Value = Nom_Promo
     'Lien hypertexte vers cette feuille
     Wsh_C.Hyperlinks.Add Anchor:=Wsh_C.Cells(C_L_Titre, Décalage + 1), Address:="", _
                                                                        SubAddress:="'" & Nom_Promo & "'!A1", _
                                                                        TextToDisplay:=Nom_Promo, _
                                                                        ScreenTip:="Voir la fiche complète"
     'Recopie des valeurs
     For i = LBound(Source) To UBound(Source)         
          Wsh_C.Range(Cible(i)).Offset(0, Décalage).Value = Wsh_S.Range(Source(i)).Value
     Next

     'Recopie des formats
     Wsh_C.Columns(Col_Modèle).Copy
     Wsh_C.Columns(Col_Modèle).Resize(, Décalage).PasteSpecial xlPasteFormats
    
     'Style Hypertexte (effacé par la recopie des formats)
     Wsh_C.Cells(C_L_Titre, Col_Modèle).Offset(0, 1).Resize(, Décalage - Col_Modèle + 1).Style = "Hyperlink"
    
     Application.ScreenUpdating = True
    
End Sub

Pour les autres stages il n'y a plus qu'à mettre à jour la procédure Récap après avoir constitué les modèles.
Voilà
A+
Alain