Sub SousTotaux()
Dim dest As Range, nvide&, ncol%, t, i&, n&, rest(), soustotal(), total(), j%
Set dest = [K1] 'cellule de destination, à adapter
nvide = 3 'nombre de lignes vides en fin de tableau, à adapter
'---initialisation---
Application.ScreenUpdating = False
With [A1].CurrentRegion
If .Rows.Count > 1 Then _
.Sort .Columns(1), xlAscending, Header:=xlYes 'tri sur les dates
ncol = .Columns.Count
t = .Resize(.Rows.Count + 1, ncol) 'matrice, plus rapide
dest.EntireColumn.Resize(, ncol) = "" 'RAZ
dest.Resize(, ncol) = Application.Index(t, 1, 0) 'titres
If .Rows.Count = 1 Then Exit Sub
End With
'---nombre d'années/sous-totaux---
For i = 2 To UBound(t) - 1
If Val(t(i + 1, 1)) = 0 Then t(i + 1, 1) = 0
If Val(t(i, 1)) Then _
If Year(t(i + 1, 1)) <> Year(t(i, 1)) Then n = n + 1
Next i '---dimensions des tableaux---
ReDim rest(1 To UBound(t) + n + nvide, 1 To ncol)
ReDim soustotal(1 To ncol)
ReDim total(1 To ncol)
'---remplissage du tableau rest---
n = 0
For i = 2 To UBound(t) - 1
If Val(t(i, 1)) Then
n = n + 1
For j = 1 To ncol
rest(n, j) = t(i, j)
If IsNumeric(t(i, j)) Then _
soustotal(j) = soustotal(j) + t(i, j): total(j) = total(j) + t(i, j)
Next j
If Year(t(i + 1, 1)) <> Year(t(i, 1)) Then
n = n + 1
rest(n, 1) = "Sous-total " & Year(t(i, 1))
For j = 2 To ncol
rest(n, j) = soustotal(j)
Next j
ReDim soustotal(1 To ncol) 'RAZ
End If
End If
Next i
'---dernière ligne du tableau rest---
n = n + nvide + 1
rest(n, 1) = "Total"
For j = 2 To ncol
rest(n, j) = total(j)
Next j
'---restitution---
dest(2).Resize(n, ncol) = rest
End Sub