Bonjour,

J’ai besoin de vous pour assemble deux code VBA que j’ai sur deux boutons ont un seul bouton
Le 1er code permet de calcule les différentes quartile présence sur une plage
2eme code permet de colorie les différents quartile sur un croisé dynamique

Ci-dessous les codes

1er code :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub QUARTILE_Par_Agent()
 
Dim Ligne As Integer
Ligne = 2
    For i = 46 To 49
        For j = 5 To 38 
            If Cells(j, 2) <= Cells(i, 2) And Cells(j, 2) > Cells(i - 1, 2) Then
                Cells(Ligne, 7) = Cells(i, 1)
                Cells(Ligne, 8) = Cells(j, 1)
                Cells(Ligne, 9) = Cells(j, 2)
                Ligne = Ligne + 1
            End If
        Next
    Next
End Sub
2eme code :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Public Sub CouleurQ()
Dim ws As Worksheet, pt As PivotTable, rngData As Range
 
    With Application
        .PivotTableSelection = True: .ScreenUpdating = False
    End With
 
    Set ws = ActiveSheet: Set pt = ws.PivotTables(1)
    Set rngData = _
            Intersect(pt.PivotFields("Quartile").PivotItems("Q1").DataRange.EntireRow, _
            pt.PivotFields("Les noms").DataRange)
    Set rngData = _
            Union(rngData, pt.PivotFields("Quartile").PivotItems("Q1").LabelRange, _
            pt.PivotFields("Quartile").PivotItems("Q1").DataRange)
    rngData.Interior.Color = vbRed
 
 
        Set ws = ActiveSheet: Set pt = ws.PivotTables(1)
    Set rngData = _
            Intersect(pt.PivotFields("Quartile").PivotItems("Q2").DataRange.EntireRow, _
            pt.PivotFields("Les noms").DataRange)
    Set rngData = _
            Union(rngData, pt.PivotFields("Quartile").PivotItems("Q2").LabelRange, _
            pt.PivotFields("Quartile").PivotItems("Q2").DataRange)
    rngData.Interior.Color = RGB(255, 165, 0)
 
 
            Set ws = ActiveSheet: Set pt = ws.PivotTables(1)
    Set rngData = _
            Intersect(pt.PivotFields("Quartile").PivotItems("Q3").DataRange.EntireRow, _
            pt.PivotFields("Les noms").DataRange)
    Set rngData = _
            Union(rngData, pt.PivotFields("Quartile").PivotItems("Q3").LabelRange, _
            pt.PivotFields("Quartile").PivotItems("Q3").DataRange)
    rngData.Interior.Color = vbYellow
 
 
 
                Set ws = ActiveSheet: Set pt = ws.PivotTables(1)
    Set rngData = _
            Intersect(pt.PivotFields("Quartile").PivotItems("Q4").DataRange.EntireRow, _
            pt.PivotFields("Les noms").DataRange)
    Set rngData = _
            Union(rngData, pt.PivotFields("Quartile").PivotItems("Q4").LabelRange, _
            pt.PivotFields("Quartile").PivotItems("Q4").DataRange)
    rngData.Interior.Color = RGB(0, 200, 100)
 
 
    Set rngData = Nothing: Set pt = Nothing: Set ws = Nothing
 
End Sub