Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B3]) Is Nothing Then Exit Sub
Dim critere, t, col, ncol%, j%, rest(), i&, n&
critere = [B3]
'---préparation---
t = Feuil1.[A1].CurrentRegion 'CodeName de la feuille
col = [Tableau].Rows(1)
ncol = UBound(col, 2)
For j = 1 To ncol
col(1, j) = Application.Match(col(1, j), Application.Index(t, 1, 0), 0)
Next
'---création du tableau rest---
ReDim rest(1 To UBound(t), 1 To ncol)
For i = 2 To UBound(t)
If t(i, 1) = "" Then t(i, 1) = t(i - 1, 1)
If t(i, 1) = critere Then
n = n + 1
For j = 1 To ncol
rest(n, j) = t(i, col(1, j))
Next j
End If
Next i
'---dimensionnement et restitution---
With [Tableau]
If n + IIf(n, 2, 3) < .Rows.Count Then
.Rows(2).Resize(.Rows.Count - n - IIf(n, 2, 3)).Delete xlUp
ElseIf n + 2 > .Rows.Count Then
.Rows(3).Resize(n + 2 - .Rows.Count).Insert xlDown
End If
If n Then .Rows(2).Resize(n) = rest Else .Rows(2) = ""
n = .Rows.Count
.Cells(n, 2).Resize(, ncol - 1) = "=SUM(R[-" & n - 2 & "]C:R[-1]C)"
End With
End Sub