Comment faire un cumul mensuel ?

Sub Resulatscat()

Dim Dict As New Scripting.Dictionary
Dim IDX As Integer
Dim Key As Variant
Dim Key1 As Variant
Dim Key2 As Variant
Dim Annee As Integer
Dim SumAnnee() As Variant
Dim NumMois As Integer
Dim CodeEtabli As String
Dim DerniereligneRCAT As Integer
Dim DerniereligneRM As Integer
Dim Colo25 As String
Dim Colo22 As String
Dim Colo28 As String
Dim Colo13 As String
Dim Colo16 As String
Dim Cumul As Double
Dim RM As Worksheet
Dim RCAT As Worksheet
Set RCAT = Sheets("RCAT")

'Libellés de colonnes
RCAT.Cells(8, 1) = "Code Etablissement "
RCAT.Cells(8, 2) = "Libellés réseau"
RCAT.Cells(8, 3) = "Codes Catégories"
RCAT.Cells(8, 4) = "Libellés Catégories"
RCAT.Cells(8, 5) = "Codes Types Financements"
RCAT.Cells(8, 6) = "Codes Départements MOA Projet"
RCAT.Cells(8, 7) = "Sous Catégories techniques"
RCAT.Cells(8, 8) = "PPI"

'Constitution de clés : onglets RM(WSlist),clés de colonnes(keylist) et les années(anneelist)

Set wslist = CreateObject("System.Collections.ArrayList")
Set Keylist = CreateObject("System.Collections.ArrayList")
Set Anneelist = CreateObject("System.Collections.ArrayList")

'Colonnes à partir desquelles on commence à remplir les mois

Anneelist.Add 8
Anneelist.Add 21
'Mise en place de la prise en compte automatique des feuilles RM

For Each WS In ThisWorkbook.Worksheets
    If WS.Name Like "*RM20*" Then
        wslist.Add WS.Name
    End If
    
Next
'classement desfichiers RM du plus ancien (N-1) au plus récent(N)
wslist.Sort

For Each WS In wslist
    
    Set RM = Sheets(WS)
    NbLigneRM = RM.Cells(Rows.Count, 1).End(xlUp).Row
    LigneRM = 2
    
    Do While LigneRM <= NbLigneRM
        CodeEtabli = RM.Cells(LigneRM, 5)
        
 'filtre sur le code établissement GI
 
        If CodeEtabli = "GI" Then
            Key = RM.Cells(LigneRM, 25) + "!" + RM.Cells(LigneRM, 22) + "!" + RM.Cells(LigneRM, 28) + "!" + RM.Cells(LigneRM, 13) + "!" + RM.Cells(LigneRM, 16) + "!" + Right(RM.Cells(LigneRM, 24), 2)
            If Not Keylist.contains(Key) Then
                Keylist.Add (Key)
'Debug.Print Key
            End If 'if not
            
            If Dict.Exists(Key) Then
                IDX = wslist.IndexOf(WS, 0)
                SumAnnee = Dict(Key)
                SumAnnee(IDX) = SumAnnee(IDX) + RM.Cells(LigneRM, 26)
                Dict(Key) = SumAnnee
            Else
                ReDim SumAnnee(0 To 1)
                SumAnnee(0) = 0
                SumAnnee(1) = 0
                IDX = wslist.IndexOf(WS, 0)
                SumAnnee(IDX) = SumAnnee(IDX) + RM.Cells(LigneRM, 26)
                Dict(Key) = SumAnnee
                
            End If
           
        End If 'codeetabli
        LigneRM = LigneRM + 1
    
    Loop
  
Next WS
DerniereligneRCAT = 8

'Ecriture des résultats
Keylist.Sort
Key2 = ""

For Each Key In Keylist
    
   Colo25 = Split(Key, "!")(0)
   Colo22 = Split(Key, "!")(1)
   Colo28 = Split(Key, "!")(2)
   Colo13 = Split(Key, "!")(3)
   Colo16 = Split(Key, "!")(4)
   WSname = CInt(Split(Key, "!")(5))
   Key1 = Colo25 + Colo22 + Colo28 + Colo13 + Colo16
   
   If Key2 <> Key1 Then
   
    DerniereligneRCAT = DerniereligneRCAT + 1
    Key2 = Key1
    
    End If
    
    RCAT.Cells(DerniereligneRCAT, 1) = "GI"
    RCAT.Cells(DerniereligneRCAT, 2) = Colo25
    RCAT.Cells(DerniereligneRCAT, 3) = Colo22
    RCAT.Cells(DerniereligneRCAT, 4) = Colo28
    RCAT.Cells(DerniereligneRCAT, 5) = Colo13
    RCAT.Cells(DerniereligneRCAT, 6) = Colo16
    RCAT.Cells(DerniereligneRCAT, 7) = Colo25 + "." + Colo22 + "." + Colo13 + "." + Colo16
    RCAT.Cells(DerniereligneRCAT, 8 + WSname) = Dict(Key)(0)
    RCAT.Cells(DerniereligneRCAT, 21 + WSname) = Dict(Key)(1)