Option Explicit

Sub fastdelrows()

    Dim el, a(), i&, x As Range

    With CreateObject("Scripting.Dictionary")

        For Each el In Sheets("Лист2").Range("C5").CurrentRegion.Value
            .Item(el) = 0&
        Next

        a = Sheets("data").Range("B1").CurrentRegion.Columns(1).Value
        ReDim b(1 To UBound(a), 1 To 1)
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then b(i, 1) = 1
        Next

    End With

    With Sheets("data")
        .Range("F1").Resize(UBound(b), 1) = b
        Set x = .[F:F].Find(1, , , xlWhole)
        If Not x Is Nothing Then
            .[F:F].ColumnDifferences(x).EntireRow.Hidden = True
            .UsedRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .Rows.Hidden = False
        End If
    End With

End Sub