Sub SousTotaux()
Dim w As Worksheet, plage As Range, zone1 As Range
Dim zone2 As Range, C As Range, i As Byte, j As Byte
Dim z1 As Range, z2 As Range, a As String
Application.ScreenUpdating = False
For Each w In Worksheets
If IsDate("1 " & w.Name) Then
Set plage = w.Range("B4", w.[B65536].End(xlUp)(2))
Set zone1 = plage.SpecialCells(xlCellTypeFormulas).EntireRow
Set zone2 = plage.SpecialCells(xlCellTypeBlanks).EntireRow
Set C = w.[G:J]
Intersect(zone2, C.Columns(1)) = "Sous-total"
For i = 2 To C.Columns.Count
For j = 1 To zone1.Areas.Count
Set z1 = Intersect(zone1.Areas(j), C.Columns(i))
Set z2 = Intersect(zone2.Areas(j), C.Columns(i))
z2.Formula = "=SUBTOTAL(9," & z1.Address(0, 0) & ")"
Next
a = Intersect(plage.EntireRow, C.Columns(i)).Address(0, 0)
z2(2).Formula = "=SUBTOTAL(9," & a & ")"
If i = 2 Then z2(2, 0) = "Total"
Next
End If
Next
End Sub