Возможно ли сделать - VB

Формулировка задачи:

Уважаемые помогите пожалуйста ,возможно ли сделать :макрос В строке ФИО при наличии слово удалить Чтоб удалились только данные ФИО долж. 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 Вс. часов Ночные Празд. Норма. А те люди которые ниже, поднялись со всеми данными (т,е не было пустой строки ) Удаление всей строки не подходит !Заранее благодарен!

Решение задачи: «Возможно ли сделать»

textual
                            Листинг программы 
                        

                            Option Explicit
Public Const ПерваяСтрокаДанных As Integer = 6
Public Const ПоследняяСтрокаДанных As Integer = 20
Public Const ПервыйСтолбецДанных As Integer = 2
Public Const ПоследнийСтолбецДанных As Integer = 38

Sub DelStr()
    Dim sRange As String
    Dim i As Integer
    Dim r As Range
    
    ' Ищем строки для удаления и формируем строку диапазона
    For i = ПерваяСтрокаДанных To ПоследняяСтрокаДанных
        If Cells(i, ПервыйСтолбецДанных) = "Удалить" Then
            sRange = sRange & IIf(Len(sRange) = 0, "", ",") _
                   & Split(Cells(i, ПервыйСтолбецДанных).Address, "$")(1) _
                   & CStr(i) & ":" _
                   & Split(Cells(i, ПоследнийСтолбецДанных).Address, "$")(1) _
                   & CStr(i)
        End If
    Next i
    ' удаляем/подчищаем
    If sRange <> "" Then
        ' удаляем ячейки диапазона со сдвигом вверх
        Range(sRange).Delete Shift:=xlUp
        
        ' исправляем нумерацию в первой колонке
        Range(Cells(ПерваяСтрокаДанных, 1), Cells(ПоследняяСтрокаДанных, 1)).ClearContents
        ' ставим начальные цифирки
        Cells(ПерваяСтрокаДанных, 1) = 1
        Cells(ПерваяСтрокаДанных + 1, 1) = 2
        ' ищем фактически последнюю заполненную строку
        i = Cells(ПерваяСтрокаДанных, ПервыйСтолбецДанных).End(xlDown).Row
        ' формируем диапазон
        sRange = Split(Columns(1).Address, "$")(2) & CStr(ПерваяСтрокаДанных) _
               & ":" & Split(Columns(1).Address, "$")(2) & CStr(i)
        ' проставляем нумерацию
        If sRange <> "" Then
            Set r = Worksheets("Табель").Range(Cells(ПерваяСтрокаДанных, 1), Cells(ПерваяСтрокаДанных + 1, 1))
            r.AutoFill Destination:=Worksheets("Табель").Range(sRange), Type:=xlFillDefault
        End If
    End If
End Sub

                        