[XL-2010] assemble deux code VBA

assemble deux code VBA

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:

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:

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

Bonjour,

Tu n'as qu'à appeler tes 2 macros lors du click sur le bouton.
Par exemple, tu crées une macro Départ que tu lies à un bouton.

Le code de cette macro
Code:

1 2 3 4 Sub Départ() Call QUARTILE_Par_Agent Call CouleurQ End Sub

Good ça marche merci bcq bien noté et bien sauvegarde