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