Bonjour à tous

Dans ma macro, je fais exécuter l'opération qui est dans: Données, Sous-totaux. Jefais le sous-total d'une données A et le sous-total d'une données B (ce sont mes colonnes) je veux faire l'opération suivante: soustotal colonne A divisé par sous-total colonne B. On ne sait pas d'avance combien il va y avoir de regroupement (car cette fonction Données, Sous-totaux commence toujours par "A chaque changement de" (et la on indique la colonne) . Donc il peut y avoir 3, 5 10, 20 rangée ou plus. Cela change à chaque semaine.
Je ne sais pas si mon explication est compréhensible. Voici mon code (présentement tout fonctionne comme je veux, J'ai indiqué en rouge le code qui fait les sous-totaux). Je suis un programmeur qui a appris sur le tas, donc mon code peut sembler bizarre, mais je me lance.

Merci

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("A1:I1").Select
 
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
    Selection.Merge
    Range("J2").Select
    Selection.Copy
    Range("A1:I1").Select
    ActiveSheet.Paste
    Range("A1:F1000").Select
    Range("I1000").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    Application.CutCopyMode = False
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5, 6, 7, 8), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
'**********************nouveau code
'Supprime les lignes où il n'y a rien
Dim R As Long
Application.ScreenUpdating = False
 
For R = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
    If Application.WorksheetFunction.CountA(Rows(R)) = 0 Then Rows(R).Delete
Next R
 
Application.ScreenUpdating = True
 
'***********************fin nouveau code
     'ajout
     Range("A1").Select
     Selection.Font.Bold = True
     Selection.Font.ColorIndex = 3
     Selection.Font.Underline = xlUnderlineStyleSingle
     Rows("1:1").RowHeight = 26.25
     Range("A2:I2").Select
     Selection.Font.Bold = True
     Selection.Font.ColorIndex = 11
    'fin ajout
 
'**************Ajout de code pour placer une ligne vide
Dim max As Long
Dim indice As Long
Dim flag_total As Boolean
 
flag_total = False
indice = 2
 
max = ActiveSheet.Range("A1000").End(xlUp).Row 'pas besoin de plus que 1000
Do While indice < max + 1
 
 Select Case True
        Case flag_total
            'fin ajout
            Rows(indice).Insert Shift:=xlDown
            flag_total = False
            max = max + 1
        Case UCase(Left(Range("A" & indice), 5)) = "TOTAL"
            flag_total = True
            'Nouvel ajout pour le caractère gras
            Rows(indice).Font.Bold = True
        Case Else
 End Select
indice = indice + 1
Loop
'****************fin de code
 
    'Cette ligne sert à cliquer sur le petit 2 dans le carré à gauche pour le sommaire
    ActiveSheet.Outline.ShowLevels RowLevels:=2
   ' sert à mettre les colonnes de la bonne largeur
    Columns("A:A").ColumnWidth = 33
    Columns("B:B").ColumnWidth = 13
    Columns("C:C").ColumnWidth = 30
    Columns("D:D").ColumnWidth = 15
    Columns("E:E").ColumnWidth = 10
    Columns("F:F").ColumnWidth = 18
    Columns("G:G").ColumnWidth = 12
 
    'Pour mettre les colonnes dans le bon format
        Columns("E:E").Select
        Selection.NumberFormat = "0"
        Columns("F:F").Select
        Selection.NumberFormat = "0.00$"
        Columns("G:G").Select
        Selection.NumberFormat = "0.00$"
         Columns("H:H").Select
        Selection.NumberFormat = "0.00$"
        Columns("I:I").Select
        Selection.NumberFormat = "0.00%"
 
    'suppression des feuille vide dans le classeur
       Sheets("Feuil2").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Feuil3").Select
    ActiveWindow.SelectedSheets.Delete
 
 '*************AJOUT POUR METTRE LA FEUILLE EN PAYSAGE
    With ActiveSheet.PageSetup
 
        .Orientation = xlLandscape
 
    End With
    '******************FIN PAYSAGE
 
'pour enlever la vue des pied de pages
      ActiveSheet.DisplayAutomaticPageBreaks = False
 
'pour se mettre à la fin des données
    Range("A65536").End(xlUp).Offset(1, 0).Select