Microsoft 365 Amélioration Macro.

[crazy]

Bonjour,

J'utilise la macro suivante afin de récapituler les données de toutes les onglets du fichier sur une feuille au début (RECAP PROJET) en fonction de la valeur de la cellule B3 de RECAP PROJET
Le principe de la macro et de rapporter le valeurs de j2 à u2 vers les colonnes k à v de la feuille RECAP. Comme vous le voyez le colonne K à V correspondent à des mois tout comme les cellules j1 à u1 dans les autres feuilles.
En fait mon fichier peut porter sur plusieurs années et Je voudrai éviter d'avoir un Macro immense (en répétant : .Range("U" & Derlig) = Ws.[T2] / .Range("V" & Derlig) = Ws.[U2] pour tous les mois).

Est-il possible que la macro ramène toutes les données dans la feuille (de J2 à U2 voire plus) vers la feuille RECAP PROJET en fonction de la valeur des cellules J1 à U1 et des valeurs des cellules K6 à V6 de la feuille RECAP.

Je ne sais pas si je suis compréhensible, je vous mets un exemple de fichier en PJ.

Merci d'avance de votre précieuse aide...

Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim Derlig&, Ws As Worksheet, GestProjet$
If Not Application.Intersect(Target, Range("b3")) Is Nothing Then
    With Worksheets("Recap PROJETS")
        GestProjet = .[B3]
        Derlig = .Range("B" & Rows.Count).End(xlUp).Row + 1
        .Range("B7:V" & Derlig) = ""
        For Each Ws In Worksheets
            Ws.Visible = True
            If Ws.Name <> "Recap PROJETS" Then
                
                If Ws.[b1] = GestProjet Then
                    Derlig = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    .Hyperlinks.Add Anchor:=.Range("B" & Derlig), Address:="", SubAddress:="'" & Ws.Name & "'!A1", TextToDisplay:=Ws.Name
                    .Range("B" & Derlig) = Ws.Name
                    .Range("C" & Derlig) = Ws.[B3]
                    .Range("D" & Derlig) = Ws.[b1]
                    .Range("E" & Derlig) = Ws.[b2]
                    .Range("F" & Derlig) = Ws.[h1]
                    .Range("G" & Derlig) = Ws.[h5]
                    .Range("H" & Derlig) = Ws.[h2]
                    .Range("I" & Derlig) = Ws.[h3]
                    .Range("J" & Derlig) = Ws.[h4]
                    .Range("K" & Derlig) = Ws.[J2]
                    .Range("L" & Derlig) = Ws.[K2]
                    .Range("M" & Derlig) = Ws.[L2]
                    .Range("N" & Derlig) = Ws.[M2]
                    .Range("O" & Derlig) = Ws.[N2]
                    .Range("P" & Derlig) = Ws.[O2]
                    .Range("Q" & Derlig) = Ws.[P2]
                    .Range("R" & Derlig) = Ws.[Q2]
                    .Range("S" & Derlig) = Ws.[R2]
                    .Range("T" & Derlig) = Ws.[S2]
                    .Range("U" & Derlig) = Ws.[T2]
                    .Range("V" & Derlig) = Ws.[U2]
                Else
                    If GestProjet = "" Then
                       Derlig = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    .Hyperlinks.Add Anchor:=.Range("B" & Derlig), Address:="", SubAddress:="'" & Ws.Name & "'!A1", TextToDisplay:=Ws.Name
                    .Range("B" & Derlig) = Ws.Name
                    .Range("C" & Derlig) = Ws.[B3]
                    .Range("D" & Derlig) = Ws.[b1]
                    .Range("E" & Derlig) = Ws.[b2]
                    .Range("F" & Derlig) = Ws.[h1]
                    .Range("G" & Derlig) = Ws.[h5]
                    .Range("H" & Derlig) = Ws.[h2]
                    .Range("I" & Derlig) = Ws.[h3]
                    .Range("J" & Derlig) = Ws.[h4]
                    .Range("K" & Derlig) = Ws.[J2]
                    .Range("L" & Derlig) = Ws.[K2]
                    .Range("M" & Derlig) = Ws.[L2]
                    .Range("N" & Derlig) = Ws.[M2]
                    .Range("O" & Derlig) = Ws.[N2]
                    .Range("P" & Derlig) = Ws.[O2]
                    .Range("Q" & Derlig) = Ws.[P2]
                    .Range("R" & Derlig) = Ws.[Q2]
                    .Range("S" & Derlig) = Ws.[R2]
                    .Range("T" & Derlig) = Ws.[S2]
                    .Range("U" & Derlig) = Ws.[T2]
                    .Range("V" & Derlig) = Ws.[U2]
                            
                              Else
                        Ws.Visible = xlVeryHidden
                    End If
                End If
            End If
        Next
    End With
End If
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

 

[Eric KERGRESSE]

Bonjour,

A tester :

 

[crazy]

Bonjour,

A tester :

Merci cela fonctionne parfaitement...

 

[crazy]

Bonjour,

A tester :

BOnjour Éric,

En fait cela fonctionne parfaitement mais dans mon fichier original je peux avoir plus de 100 onglets et cela devient très long a faire tourner.
Penses tu qu'il y a une possibilité pour "accélérer" ou "alléger" le tout?

 

[Eric KERGRESSE]

Tu pourrais faire apparaître tous les onglets dans l'onglet récap, les valeurs mensuelles seraient récupérées par une formule et tu filtrerais par gestionnaire. L'inconvénient, le fichier va être tout aussi long pour la mise à jour compte tenu du nombre de formules.

Autre solution : 1 fichier par gestionnaire mis à jour par vba + 1 fichier de synthèse avec des requêtes Power Query fusionnées pour la consolidation.

Pb : Les conseilleurs ne sont pas les payeurs...

 

[crazy]

Tu pourrais faire apparaître tous les onglets dans l'onglet récap, les valeurs mensuelles seraient récupérées par une formule et tu filtrerais par gestionnaire. L'inconvénient, le fichier va être tout aussi long pour la mise à jour compte tenu du nombre de formules.

Autre solution : 1 fichier par gestionnaire mis à jour par vba + 1 fichier de synthèse avec des requêtes Power Query fusionnées pour la consolidation.

Pb : Les conseilleurs ne sont pas les payeurs...

Merci de ta réponse.
Aussi j'aik une dernière question, penses tu que suite à la sélection du Gestionnaire en B3 de la feuille RECAP, penses tu qu'il est possible de faire apparaître que les onglets qui sont listé dans la feuille RECAP.
POur faire simple quand aucun gestionnaire n'est sélectionné tous les onglets doivent apparaître ; mais lorsque je sélectionne un gestionnaire ne doivent apparaître que les onglets qui le concerne (Feuil1 pour XXX mais il peut y avoir bien plus d'onglet par gestionnaire).

MErci

 

[Eric KERGRESSE]

A tester :

 

[crazy]

A tester :

Merci de ta rapidité. Cela fonctionne le seul soucis est que lorsque la cellule B3 est vide il n'y a pas tous les onglets ; il ya juste les onglets pour lesquels le gestionnaire est vide.
Or il faudrait que tous les onglets apparaissent lorsque B3 de RECAP et vide.

Merci beaucoup