Public Sub delVisibleTableRows3()
    Dim pLo As ListObject, pLc As ListColumn, t As Double, i As Long, n As Long
    t = Timer

    Set pLo = shDB.ListObjects(1)
    Set pLc = pLo.ListColumns.Add                     ' добавочный столбец
    pLc.Range.Cells(2, 1).FormulaR1C1 = "=IF(OR(RC[-4]=1,RC[-4]=2),1,0)"
    With pLo.Sort                                     ' сортировка
        .SortFields.Clear
        .SortFields.Add pLc.Range
        .Apply
    End With
    i = Application.WorksheetFunction.CountIf(pLc.DataBodyRange, 1)
    If i > 0 Then                                     ' удаление строк
        With pLc.Range
            n = .Cells.Count
            .Offset(n - i).Resize(i).EntireRow.Delete
        End With
    End If

    pLc.Delete                                        ' удаление добавочного столбца

    MsgBox Timer - t
End Sub

Option Explicit
' Пробуем удалить отфильтрованные ячейки (строки целиком). Фильтр по первому столбцу поставлен макросом: 1 и 3
Private Sub Main()
Dim tbl As ListObject, tblCol As ListColumn
Dim tWork!, tPrepare!
Dim n&
Application.ScreenUpdating = 0: On Error GoTo er
Set tbl = shDB.ListObjects(1): tPrepare = Timer
[_reserveMove].Copy: shDB.[a2].PasteSpecial Paste:=xlPasteValues: Application.CutCopyMode = 0
tPrepare = Round(Timer - tPrepare, 4)

tWork = Timer: Set tblCol = tbl.ListColumns.Add
tblCol.DataBodyRange.FormulaR1C1 = "=if(or(rc[-4]=1,rc[-4]=3),0,1)"
    With tbl.Sort
        .SortFields.Clear
        .SortFields.Add tblCol.Range
        .Apply
    End With
n = Application.WorksheetFunction.CountIf(tblCol.DataBodyRange, 0)
'tbl.DataBodyRange.Rows("1:" & n).Delete
tblCol.DataBodyRange.Resize(n).EntireRow.Delete
tblCol.Delete: tWork = Round(Timer - tWork, 4): shDB.Select

ex:
MsgBox "Общее время макроса (сек.): " & tPrepare + tWork & vbLf & vbLf & _
"Время подготовки (сек.): " & tPrepare & vbLf & _
"Время работы (сек.): " & tWork, vbInformation, "ГОТОВО"

GoTo fin
er: MsgBox "Что-то пошло не так…", vbCritical, "НЕПРЕДВИДЕННАЯ ОШИБКА"
fin: On Error GoTo 0: Application.ScreenUpdating = 1
End Sub

Option Explicit


'========== Сначала хотел сделать вот такой сравнительный стенд))))
'Private Sub Main()
'Dim tbl As ListObject, tblCol As ListColumn, ar As Range, rng As Range
'Dim tFullTime!, tWork!, tPrepare!, tKaz!, tRAN!, tAVG1!, tAVG2!, tSokol!
'Dim iVar As Byte, i&, n&
'Application.ScreenUpdating = 0: On Error GoTo er
'Set tbl = shDB.ListObjects(1): tFullTime = Timer
'
'lblStart:
'iVar = iVar + 1
'[_reserveMove].Copy: shDB.[a2].PasteSpecial Paste:=xlPasteValues: Application.CutCopyMode = 0
'
'If iVar = 2 Then GoTo lblRAN
'If iVar = 3 Then GoTo lblAVG1
'If iVar = 4 Then GoTo lblAVG2
'If iVar = 5 Then GoTo lblSokol
'
'lblKaz:
'
'
'
'
'lblRAN:
'tRAN = Timer
'tbl.Range.AutoFilter 1, "=1", xlOr, "=3"
'Set rng = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible).EntireRow
'    For Each ar In rng.Areas
'        ar.Delete
'    Next
'tbl.Range.AutoFilter: tRAN = Round(Timer - tRAN, 4): GoTo lblStart
'
'lblAVG1:
'
'
'
'
'lblAVG2:
'
'
'
'lblSokol:
'tSokol = Timer: Set tblCol = tbl.ListColumns.Add
'tblCol.DataBodyRange.FormulaR1C1 = "=if(or(rc[-4]=1,rc[-4]=3),0,1)"
'    With tbl.Sort
'        .SortFields.Clear
'        .SortFields.Add tblCol.Range
'        .Apply
'    End With
'i = Application.WorksheetFunction.CountIf(tblCol.DataBodyRange, 0)
'    With tblCol.DataBodyRange
'        n = .Cells.Count
'        .Resize(i).EntireRow.Delete
'    End With
'tblCol.Delete: tSokol = Round(Timer - tSokol, 4): GoTo ex
'
''Set tblCol = tbl.ListColumns(1)
'
'ex:
'tFullTime = Round(Timer - tFullTime, 2)
'tWork = Round(tKaz + tRAN + tAVG1 + tAVG2 + tSokol, 2)
'tPrepare = Round(tFullTime - tWork, 2)
'
'MsgBox "Общее время макроса (сек.): " & tFullTime & vbLf & _
'"Общее время всех подготовок (сек.): " & tPrepare & vbLf & _
'"Среднее время каждой подготовки (сек.): " & Round(tPrepare / 5, 2) & vbLf & vbLf & _
'"Общее время работы всех вариантов (сек.): " & tWork & " из них …" & vbLf & _
'"«Казанский» " & tKaz & vbLf & _
'"«RAN» " & tRAN & vbLf & _
'"«Андрей VG (1)» " & tAVG1 & vbLf & _
'"«Андрей VG (2)» " & tAVG2 & vbLf & _
'"«Sokol92» " & tSokol, vbInformation, "ГОТОВО"
'
'GoTo fin
'er: MsgBox "Что-то пошло не так…", vbCritical, "НЕПРЕДВИДЕННАЯ ОШИБКА"
'fin: On Error GoTo 0: Application.ScreenUpdating = 1
'End Sub