Макрос на поиск содержимого из столбца А в остальных столбцах - MS Excel - VBA

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

Добрый день! Ситуация такая. В столбце А слова: нос кот мышь В столбце В фразы: длинный нос кот спит нос тихо мышь сопит два попугая Задача - чтобы макрос удалил из столбца В те ячейки, в которых

содержатся

слова из столбца А. Т.е должно остаться: два попугая. Но тот макрос, который я нашел, во-первых, удаляет только полное совпадение: "нос" = "нос", но игнорирует "длинный нос". А во-вторых, хочется загрузить в макрос весь столбец А, чтобы не вставлять в макрос по одному слову, а как это сделать в нем - я не знаю. Помогите, пжлст )) Ниже макрос:

Sub Udalenie_Strok_Po_Shablonu()
    Dim r As Long, FirstRow As Long, LastRow As Long
    Dim Region As Range, iRow As Range, Cell As Range
    Dim Shablon As String
 
    Shablon = "здесь вводится искомый текст"
 
    Set Region = ActiveSheet.UsedRange
    FirstRow = Region.Row
    LastRow = Region.Row - 1 + Region.Rows.Count 
        For r = LastRow To FirstRow Step -1
        Set iRow = Region.Rows(r - FirstRow + 1)
            For Each Cell In iRow.Cells
                If Cell Like Shablon Then
                    Rows(r).Delete
                End If
            Next Cell
        Next r
End Sub

Признателен за ответы!

Немного неправильно написал. Вот так точнее: В столбце А слова: один два три В столбце В, С, D и так далее - фразы: сорок один пятьдесят один сорок два два пятьдесят три сорок три четыре сорок четыре пятьдесят и так далее. Задача - чтобы макрос удалил из столбцов В, С и далее те ячейки, в которых

содержатся

слова из столбца А. Т.е должно остаться: четыре сорок четыре пятьдесят Но тот макрос, который я нашел, во-первых, удаляет только полное совпадение: "три" = "три", но игнорирует "три сорок". А во-вторых, хочется загрузить в макрос весь столбец А, чтобы не вставлять в макрос по одному слову, а как это сделать в нем - я не знаю. Помогите, пжлст ))

Решение задачи: «Макрос на поиск содержимого из столбца А в остальных столбцах - MS Excel»

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

                            Sub Vito()
Dim x
  With Range(Columns(2), Columns(Columns.Count))
    For Each x In Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
      .Replace "*" & Trim$(x) & "*", "", xlWhole
    Next
    .SpecialCells(xlCellTypeBlanks).Delete xlUp
  End With
End Sub
                        