Макросы в Excel

Function DeleteBlankRows(ByVal arr As Variant, ByVal col As Long) As Variant
    ' осуществляет удаление пустых строк из массива
   ' получает в качестве параметров исходный массив, и номер столбца,
   ' по которому определяется, является ли строка постой
   ' возвращает новый массив (с меньшей размерностью по вертикали)
   If Not IsArray(arr) Then MsgBox "Это не массив!", vbCritical: Exit Function
    If col > UBound(arr, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function
    If col < LBound(arr, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function

    Dim iCount As Long    ' кол-во непустых строк
   For i = LBound(arr) To UBound(arr)
        iCount = iCount - (arr(i, col) <> "")
    Next i

    ReDim narr(LBound(arr, 1) To iCount + LBound(arr, 1) - 1, LBound(arr, 2) To UBound(arr, 2))

    iCount = LBound(narr)    ' счётчик записей
   For i = LBound(arr, 1) To UBound(arr, 1)
        If arr(i, col) <> "" Then
            For j = LBound(arr, 2) To UBound(arr, 2)
                narr(iCount, j) = arr(i, j)
            Next j
            iCount = iCount + 1
        End If
    Next i

    DeleteBlankRows = narr
End Function

Sub ПримерИспользования()
    On Error Resume Next
    arr = [a1:d15] ' считываем значения ячеек диапазона [a1:d15] в массив arr
   
    ' получаем массив arr2, в 5-м столбце которого нет пустых значений
   arr2 = DeleteBlankRows(arr, 5)
   
    [f1:z111].Clear ' очищаем диапазон ячеек [f1:z111] на листе
   
    ' вставляем массив без пустых строк обратно на лист
   [f1].Resize(UBound(arr2, 1), UBound(arr2, 2)).Value = arr2
End Sub