Вставить строку, если ячейка содержит «&»

Question

Возможно, что-то простое я пропустил, но мне нужно пробежаться вниз по столбцу и скопировать и вставить все строки, которые имеют "&" в ячейке.

Мне удалось добраться до этого места, но теперь он просто застревает в самой первой ячейке с "&" и не может пройти мимо него.

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Working")

Dim rng As Range

On Error Resume Next

ws.Range("A2").Select

Do Until ActiveCell.Offset(1, 0) = Empty
    If InStr(ActiveCell, "&") <> 0 Then GoTo InsertRow Else
    ActiveCell.Offset(1, 0).Select
Loop

InsertRow:
    Set rng = ActiveCell.Rows
    rng.Rows.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    ActiveCell.Offset(2, 0).Select
    Resume Next

Возможно, в столбце могут быть пробелы, но я могу отредактировать это позже, если макрос действительно может проходить мимо первой ячейки, и все будет в порядке. Там нет сообщений об ошибках, поскольку он просто придерживается первой ячейки, которая содержит «&».

Это до и после, второе изображение показывает копируемые строки.

Answer 1

• нет выбора, активации, ActiveCell и т. Д.
• нет OnError
• нет Резюме
• итерация снизу вверх

---

Option Explicit
Sub dupAmps()
    Dim WS As Worksheet, C As Range
    Dim LR As Long
    Dim I As Long
Set WS = Worksheets("sheet1")
With WS
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

For I = LR To 2 Step -1
    Set C = WS.Cells(I, 1)
    If InStr(C, "&") > 0 Then
        C.EntireRow.Insert shift:=xlDown
        C.EntireRow.Copy C.Offset(-1, 0)
    End If
Next I

End Sub