Bonjour à tous,

J'ai une macro qui fonctionne depuis que je l'ai créée (il y 8 mois) et voici qu'elle ne fonctionne plus...
Je ne sais pas d'où cela vient et j'avais vraiment galéré à la faire, je ne sais pas d'où vient l'erreur.
Ce code me permettait de mettre une ligne "Sous total nomduclient" en faisant un regroupement des clients en prenant la partie avant le "/" de leur nom. Par exemple je peux avoir des clients avec les nom :
client1
client1/ab
client1 /bc
client1
et je fais un sous-total (des montants associés) pour "client1"
Le problème est que depuis aujourd'hui, la macro fait le sous-total seulement pour le dernier client de mon tableau et supprime tous les autres.

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
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
Sub CommandButton1_Click()
    Dim i&, j&, X&
    Dim D As Object, DTmp As Object, DCode As Object
    Dim TReport As Variant, TTmp As Variant, TData As Variant
    Dim Code$, Plg As Range
 
    Set D = CreateObject("Scripting.dictionary")
    Set DTmp = CreateObject("Scripting.dictionary")
    Set DCode = CreateObject("Scripting.dictionary")
    ReDim TReport(0)
 
    With Sheets("Feuil1")
        Set Plg = .Range(.Cells(2, 1), .Cells(Rows.Count, 5).End(3))
    End With
 
    TData = Plg
    For i = LBound(TData, 1) To UBound(TData, 1)
        If InStr(TData(i, 1), "Sous Total ") = 0 Then
            Code = Split(TData(i, 4), "/")(0)
            If Not DCode.Exists(Code) Then
                ReDim Preserve TReport(1 To UBound(TReport) + 1)
                ReDim TTmp(2)
                Set TTmp(1) = CreateObject("Scripting.dictionary")
                TTmp(2) = Code
                TReport(UBound(TReport)) = TTmp
                DCode(Code) = UBound(TReport)
            End If
            Set DTmp = TReport(DCode(Code))(1)
            X = DTmp.Count
            ReDim TTmp(1 To UBound(TData, 2))
            For j = LBound(TData, 2) To UBound(TData, 2)
                TTmp(j) = CStr(TData(i, j))
            Next j
            TReport(DCode(Code))(0) = TReport(DCode(Code))(0) + TData(i, 5)
            DTmp(X) = TTmp
            Set TReport(DCode(Code))(1) = DTmp
        End If
    Next i
    Application.ScreenUpdating = False
    Plg.ClearContents
    With Sheets("Feuil1")
        For i = LBound(TReport) To UBound(TReport)
            Set DTmp = TReport(i)(1)
            .Cells(.Rows.Count, 1).End(3)(2).Resize(DTmp.Count, 5).FormulaLocal = Application.Index(DTmp.Items, , 0)
            With .Cells(.Rows.Count, 1).End(3)(2)
                .Value = "Sous Total " & TReport(i)(2)
                .Offset(, 4) = TReport(i)(0)
            End With
        Next i
    End With
End Sub
Merci à toute personne pouvant m'aider!