VBA Цикл While, копирование и удаление строк, введенных пользователем VBA

Пытаюсь просмотреть столбец D на похожие слова, слова пользователь вписывает сам, если слово похоже, то строчку нужно скопировать на новый лист, и продолжить поиск, лист создан в программе ранее, у меня цикл ходит по кругу или ошибка, как исправить?

Sub A6()
Dim b As String

c = InputBox("Введите город для анализа:")
a = InputBox("Введите должность для анализа:")
b = MsgBox("Есть ли ещё варианты названия данной должности?", vbYesNo)

If b = vbYes Then a_1 = InputBox("Введите ещё должность для анализа:")

Range("D:D").Activate
Do While ActiveCell.Value <> ""
If ActiveCell.Value Like a Or ActiveCell.Value Like a_1 Then
Sheets("vacancy").Range("A2:M2000").Value = Rows(ActiveCell.Row).Value

Else
ActiveCell.Offset(1, 0).Activate
End If
Loop

End Sub