Option Explicit
'====================================================================================================
Sub FilterArray()
Dim arr, arrNew(), r&, rNew&, c&, t!

t = Timer
arr = Range("A1:L33").Value2
ReDim arrNew(1 To UBound(arr, 1), 1 To UBound(arr, 2))

    For r = 1 To UBound(arr, 1)
        If arr(r, 5) = "ООО Пупкин" And arr(r, 10) > Date Then
            rNew = rNew + 1
            For c = 1 To UBound(arr, 2)
                arrNew(rNew, c) = arr(r, c)
            Next c
        End If
    Next r

If rNew = 0 Then MsgBox "По выбранным критериям нет данных!", vbExclamation, "ПУСТО": Exit Sub

Application.ScreenUpdating = False
Range("N1").Resize(1, UBound(arrNew, 2)).EntireColumn.Delete
Range("N1").Resize(rNew, UBound(arrNew, 2)).Value2 = arrNew
Application.ScreenUpdating = True

MsgBox "ГОТОВО", vbInformation, Format$(1000 * (Timer - t), "0 мс")
End Sub
'====================================================================================================