Bonjour,

Je commence mon apprentissage dans la programmation de macros sous Excel 2010.
J'ai un petit souci sur la macro que j'ai écrit :

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
'Suspension temporaires pour la macro
Application.ScreenUpdating = False
 
'Déclaration des variables
Dim TempColl() As String
Dim Test As Range
Dim ChekCell As String
Dim Cellule As Range
Dim CollNames() As String
Dim a As Integer
 
 
' ****** Programme Principal ******
a = 0
ChekCell = ""
Oldchek = ""
 
' ==== Etape 1 : Récupérer valeurs uniques
 
If (Sh.Name <> "== RECAP ==") Then
 For Each Sh In ThisWorkbook.Worksheets
  If (Sh.Name <> "== RECAP ==") And (Sh.Range("F2").Value = "Liste Complète") Then
   For Each Cellule In Sh.Range("A2:A50")
    If Not (IsError(Cellule.Value)) And (Oldchek <> Cellule.Value) Then
     If (InStr(1, ChekCell, Cellule.Value) = 0) Then
      If (a > 0) Then ChekCell = ChekCell + "-"
      'TempColl(a, 1) = Cellule.Value
      ChekCell = ChekCell + Cellule.Value
      Oldchek = Cellule.Value
      a = a + 1
     End If
    End If
   Next Cellule
  End If
 Next Sh
 
 CollNames = Split(ChekCell, "-")
 
' ==== Etape 2 : Affichage liste
 
 cc = 0
 For zz = 0 To UBound(CollNames)
  If (CollNames(zz) <> "AUTRES BANDES") Then
   Sheets("== RECAP ==").Range("A22").Offset(cc, 0).Clear
   Sheets("== RECAP ==").Range("A22").Offset(cc, 0) = CollNames(zz)
   cc = cc + 1
  End If
 Next zz
 
 Sheets("== RECAP ==").Range("A22").Offset(cc + 1, 0).Clear
 Sheets("== RECAP ==").Range("A22").Offset(cc + 1, 0) = "AUTRES BANDES"
 
' ==== Etape 3 : Tri ordre alphabétique
 
 Range("A22").Select
    ActiveWorkbook.Worksheets("== RECAP ==").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("== RECAP ==").Sort.SortFields.Add Key:=Range( _
        "A22"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("== RECAP ==").Sort
        .SetRange Range(ActiveCell, ActiveCell.Offset(UBound(CollNames) - 1, 0))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
' ==== Etape 4 : Affichage de résultats
 
 lt = UBound(CollNames) - 1
 
 For bb = 0 To lt
  Sheets("== RECAP ==").Range("B22").Offset(bb, 0).Clear
  Sheets("== RECAP ==").Range("B22").Offset(bb, 0).FormulaR1C1 = "=MultiSheets_Find(RC[-1])"
 Next bb
 
 Sheets("== RECAP ==").Range("B22").Offset(bb + 1, 0).Clear
 Sheets("== RECAP ==").Range("B22").Offset(bb + 1, 0).FormulaR1C1 = "=MultiSheets_Find(RC[-1])"
 
 Sheets("== RECAP ==").Range("A22").Offset(bb + 3, 0) = "TOTAL"
 '--- Ici pour afficher la somme des cellules en RANGE ("B22").Offset(bb+3, 0) ----
 
 End If
 
'Réactivation pour la macro
Application.ScreenUpdating = True
 
End Sub
Mon problème est simple : Comment faire pour afficher la sommes des cellules entre B22 et (B22 + lt + 1), puisque la plage de cellule à additionner est dynamique ?

Je profite de ce message pour vous demander si vous voyez des optimisations à faire sur mon code.

A noter que la formule MultiSheets_find est une fonction que j'ai programmé. En voici le 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
Public Function MultiSheets_Find(A_Chercher As String)
 
Dim Sh As Worksheet
Dim Cellule As Range
Dim occurrence As Integer
 
occurrence = 0
 
For Each Sh In ThisWorkbook.Worksheets
 If (Sh.Name <> "== RECAP ==") Then
  For Each Cellule In Sh.Range("A2:A40")
    If Not (IsError(Cellule.Value)) Then
     If (Cellule.Value = A_Chercher) Then
      occurrence = occurrence + 1
     End If
    End If
  Next Cellule
 End If
Next Sh
 
MultiSheets_Find = occurrence
 
End Function
Merci d'avance de vos remarques et de votre aide,
Cordialement