Microsoft 365 somme et cellules fusionnées

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [B:B]) Is Nothing Then
         Application.ScreenUpdating = False
         DL = [B65500].End(xlUp).Row
         T = Range("A2:B" & DL) ' transfert dans array
         For i = 1 To UBound(T)
            If T(i, 1) = "" Then T(i, 1) = T(i - 1, 1)  ' on remplit le tableau pour les cellules vides ( fusionnées )
         Next i
         With Sheets("Feuil2")
            .Range("A2:B1000").ClearContents
            Ligne = 2: Somme = 0: Item = T(1, 1)
            For i = 1 To UBound(T)
                If T(i, 1) = Item Then
                    Somme = Somme + T(i, 2)
                Else
                    .Cells(Ligne, "A") = Item
                    .Cells(Ligne, "B") = Somme
                    Ligne = Ligne + 1: Somme = 0: Item = T(i, 1)
                    i = i - 1 ' on recule d'un pour le pointeur pour reprendre correctement avec le nouvel item
                End If
            Next i
            .Cells(Ligne, "A") = Item   ' on range la dernière valeur trouvée
            .Cells(Ligne, "B") = Somme
         End With
    End If
Fin:
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Activate()
Dim tablo, ub&, n&, i&, j&
tablo = Feuil1.[A1].CurrentRegion.Resize(, 2)
ub = UBound(tablo)
n = 1
For i = 2 To ub
    If tablo(i, 1) <> "" Then
        n = n + 1
        tablo(n, 1) = tablo(i, 1)
        tablo(n, 2) = tablo(i, 2)
        For j = i + 1 To ub
            If tablo(j, 1) <> "" Then i = j - 1: Exit For
            tablo(n, 2) = tablo(n, 2) + tablo(j, 2)
        Next j
    End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A1] '1ère cellule de destination, à adapter
    .Resize(n, 2) = tablo
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
End Sub

=FILTRE(Feuil1!A2:A99;Feuil1!A2:A99<>"")

=SOMME(FILTRE(Feuil1!B$2:B$999;(LIGNE(Feuil1!A$2:A$999)>=PETITE.VALEUR(SI(Feuil1!A$2:A$999<>"";LIGNE(Feuil1!A$2:A$999);"");LIGNES($1:1))) * (LIGNE(Feuil1!A$2:A$999)<SIERREUR(PETITE.VALEUR(SI(Feuil1!A$2:A$999<>"";LIGNE(Feuil1!A$2:A$999);"");LIGNES($1:2));VRAI))))