Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E3:E4]) Is Nothing Then Exit Sub
Dim a$, mem, j%, i&
[E4].Select
Application.ScreenUpdating = False
Application.EnableEvents = False
With ListObjects(1).Range
If [E3] <> "" And [E3] <> Int(Val([E3])) Then [E3] = Int(Val([E3]))
If [E3] <> "" And (Val([E3]) < 1 Or Val([E3]) > .Columns.Count) Then [E3] = ""
If [E3] = "" Then a = .Rows(2).Address(0, 0) Else a = .Cells(2, [E3]).Address(0, 0)
mem = .Formula 'mémorise
For j = IIf([E3] = "", 1, [E3]) To IIf([E3] = "", .Columns.Count, [E3])
For i = 2 To .Rows.Count
.Cells(i, j) = "'" & .Cells(i, j).Text 'valeur affichée
Next i, j
.Cells(2, .Columns.Count + 2) = "=SUMPRODUCT(N(ISNUMBER(SEARCH(E$4," & a & "))))"
.AdvancedFilter xlFilterInPlace, .Cells(1, .Columns.Count + 2).Resize(2)
.Cells(2, .Columns.Count + 2) = ""
For j = IIf([E3] = "", 1, [E3]) To IIf([E3] = "", .Columns.Count, [E3])
For i = 2 To .Rows.Count
.Cells(i, j) = mem(i, j) 'valeur initiale
Next i, j
End With
Application.EnableEvents = True
End Sub