Option Explicit
'===========================================================================================
Sub iFilter()
Dim tbl As ListObject
Dim arr, tx$, r&

arr = [a2:a23].Value2
For r = 1 To UBound(arr, 1)
'    If arr(r, 1) <> 0 Then arr(r, 1) = 1        ' скрин 2
    If arr(r, 1) <> 1 Then arr(r, 1) = Empty    ' скрин 3
Next r

On Error Resume Next: ActiveSheet.ShowAllData: On Error GoTo 0
Set tbl = ActiveSheet.ListObjects(1)
tbl.ListColumns(2).DataBodyRange.ClearContents
tbl.Range.AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlFilterValues
'With Intersect(tbl.DataBodyRange, tbl.Range): End With
tbl.ListColumns(2).DataBodyRange.Value2 = arr
End Sub
'===========================================================================================
'Set tbl = ActiveSheet.ListObjects(1)
'
'         Dim x, y, ApEv, ApSc
'         With tbl.DataBodyRange
'          x = Selection.Address
'            With Range(.Address)
'            y = .Offset(-1, 0).Resize(.Rows.Count + 1).Address
'            End With
'            If Not Intersect(Range(y), Selection) Is Nothing Then
'            ApEv = Application.EnableEvents
'            ApSc = Application.ScreenUpdating
'            Application.EnableEvents = False
'            Application.ScreenUpdating = False
'            Cells(.Row + .Rows.Count + 1, 1).Activate
'            Application.EnableEvents = ApEv
'            Application.ScreenUpdating = ApSc
'            End If
'         End With
'
'tbl.ListColumns(2).DataBodyRange.Value2 = arr
'
'         With tbl.DataBodyRange
'            If Intersect(Range(y), Selection) Is Nothing Then
'            ApEv = Application.EnableEvents
'            ApSc = Application.ScreenUpdating
'            Application.EnableEvents = False
'            Application.ScreenUpdating = False
'            Range(x).Select
'            Application.EnableEvents = ApEv
'            Application.ScreenUpdating = ApSc
'            End If
'         End With

Option Explicit
'===========================================================================================
Sub iFilter()
Dim tbl As ListObject
Dim aData, aFilt, tx$, r&, f As Boolean

Set tbl = ActiveSheet.ListObjects(1)
tbl.ListColumns(2).DataBodyRange.Value2 = "old"

aData = tbl.ListColumns(1).DataBodyRange.Value2
aFilt = tbl.ListColumns(2).DataBodyRange.Value2

For r = 1 To UBound(aData, 1)
    f = (aFilt(r, 1) = "old")
    If f Then f = (aData(r, 1) = 2 Or aData(r, 1) = 3)
    If f Then f = False: aFilt(r, 1) = "f" Else aFilt(r, 1) = Empty
Next r

Application.ScreenUpdating = False
    On Error Resume Next: ActiveSheet.ShowAllData: On Error GoTo 0
    tbl.ListColumns(2).DataBodyRange.Value2 = aFilt
    tbl.Range.AutoFilter Field:=2, Criteria1:="f", Operator:=xlFilterValues
    tbl.ListColumns(2).DataBodyRange.ClearContents
Application.ScreenUpdating = True
End Sub
'===========================================================================================