Option Explicit
'Option Private Module
'====================================================================================================
Sub DelByArrFilt() ' не нарушает сортировку таблицы. Забирает диапазон в массив, фильтрует в памяти, очищает диапазон и выгружает на него отфильтрованный массив. Можно сделать с 2мя массивами, но этот вариант в 2 раза экономичней по памяти (её может не хватить при больших таблицах)
Dim sh As Worksheet, rng As Range
Dim arr, t!, r&, rr&, c&, lr&

t = Timer: Set sh = ActiveSheet                     ' присваиваем переменной листа активный лист (можно поменять лист тут)
lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row       ' определяем последнюю строку по столбцу 1 (A)
Set rng = sh.Range("A2:N" & lr): arr = rng.Value    ' считаем, что в таблице столбцы A:N

For r = 1 To UBound(arr, 1) ' цикл строкам массива
    If Len(arr(r, 6)) Then  ' если в столбце 6 (F) есть значение
        rr = rr + 1         ' увеличиваем счётчик новых строк на 1
        If r <> rr Then     ' если номер текущей строки не равен новой
            For c = 1 To UBound(arr, 2) ' цикл по столбцам массива
                arr(rr, c) = arr(r, c)  ' переписываем строку
            Next c
        End If
    End If
Next r
If rr = UBound(arr, 1) Then MsgBox "Nothing to DELETE!", vbExclamation, "EMPTY": Exit Sub

Application.ScreenUpdating = False
rng.Value2 = Empty: rng.Borders.LineStyle = False   ' очищаем диапазон и границы ячеек
With rng.Cells(1, 1).Resize(rr, UBound(arr, 2))
    .Value = arr: .Borders.LineStyle = True         ' вставляем отфильтрованный массив и рисуем границы по нему
End With
Application.ScreenUpdating = True
MsgBox "Rows delete: " & Format$(UBound(arr, 1) - rr, "#,##0"), vbExclamation, Format$(Timer - t, "0.0 sec")
End Sub
'====================================================================================================
Sub DelByGroup()    ' собирает группу ячеек для удаления обычным способом
Dim sh As Worksheet, gr As Range, fGr As Boolean
Dim arr, t!, r&, lr&

t = Timer: Set sh = ActiveSheet
lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
arr = sh.Range("F1:F" & lr).Value2  ' берём в массив с первой строки столбец 6 (F) с критериями

For r = 2 To UBound(arr, 1)
    If Len(arr(r, 1)) = 0 Then
        If fGr Then
            Set gr = Union(gr, sh.Cells(r, 1))
        Else
            fGr = True
            Set gr = sh.Cells(r, 1)
        End If
    End If
Next r
If Not fGr Then MsgBox "Nothing to DELETE!", vbExclamation, "EMPTY": Exit Sub

Application.ScreenUpdating = False
r = gr.Cells.Count: gr.EntireRow.Delete
MsgBox "Rows delete: " & Format$(r, "#,##0"), vbExclamation, Format$(Timer - t, "0.0 sec")
Application.ScreenUpdating = True
End Sub
'====================================================================================================
Sub DelByGroupFast() ' собирает АДРЕСА ячеек для удаления, объединяет в строку, режет строку на блоки по ~255 символов и в цикле по блокам удаляет строки
Dim sh As Worksheet
Dim arr, arrAdr() As String, t!, r&, rr&, lr&

t = Timer: Set sh = ActiveSheet
lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
arr = sh.Range("F1:F" & lr).Value2  ' берём в массив с первой строки столбец 6 (F) с критериями
ReDim arrAdr(1 To lr)

For r = 2 To UBound(arr, 1)
    If Len(arr(r, 1)) = 0 Then rr = rr + 1: arrAdr(rr) = "A" & r
Next r
If rr = 0 Then MsgBox "Nothing to DELETE!", vbExclamation, "EMPTY": Exit Sub

ReDim Preserve arrAdr(1 To rr): Application.ScreenUpdating = False
For Each arr In PRDX_RngArrFromAddress(arrAdr, sh)
    arr.EntireRow.Delete
Next arr
MsgBox "Rows delete: " & Format$(rr, "#,##0"), vbExclamation, Format$(Timer - t, "0.0 sec")
Application.ScreenUpdating = True
End Sub
'----------------------------------------------------------------------------------------------------
Function PRDX_RngArrFromAddress(arrORadr, Optional sh As Worksheet) As Range()
Dim arr() As Range
Dim txAdr$, l&, n&, i&, p&, m&

If sh Is Nothing Then Set sh = ActiveSheet
If TypeName(arrORadr) <> "String" Then txAdr = Join(arrORadr, ",") Else txAdr = arrORadr

If InStr(txAdr, "$") Then txAdr = Replace$(txAdr, "$", "")
l = Len(txAdr): If l < 256 Then ReDim arr(0): Set arr(0) = sh.Range(txAdr): GoTo fin
m = l - 256

ReDim arr(l \ 200): n = -1
    Do
        i = InStrRev(txAdr, ",", p + 256)
        n = n + 1: Set arr(n) = sh.Range(Mid$(txAdr, p + 1, i - p - 1))
        p = i

        If p > m Then
            n = n + 1: Set arr(n) = sh.Range(Right$(txAdr, l - p))
            ReDim Preserve arr(n): GoTo fin
        End If
    Loop

fin: PRDX_RngArrFromAddress = arr
End Function
'====================================================================================================
Sub DelBySort() ' сортирует по столбцу 6 (F) для удаления строк одним блоком. Можно ПЕРЕД сортировкой по F создать столбец исходной сортировки и отсортировать по нему ПОСЛЕ удаления (и удалить этот вспомогательный столбец, если нужно)
Dim sh As Worksheet, rng As Range
Dim t!, lr1&, lr2&

t = Timer: Set sh = ActiveSheet
lr1 = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A2:N" & lr1)
Application.ScreenUpdating = False

With sh.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("F2:F" & lr1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange rng
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

lr2 = sh.Cells(sh.Rows.Count, 6).End(xlUp).Row ' определяем последнюю строку по столбцу 6 (F)
If lr1 <= lr2 Then Application.ScreenUpdating = True: MsgBox "Nothing to DELETE!", vbExclamation, "EMPTY": Exit Sub

Rows(lr2 + 1 & ":" & lr1).Delete: Application.ScreenUpdating = True
MsgBox "Rows delete: " & Format$(lr1 - lr2, "#,##0"), vbExclamation, Format$(Timer - t, "0.0 sec")
End Sub