Вырезать всю строку, где указанная ячейка c содержит ключевое слово, и вставить его в новый лист, сдвигая оставшиеся ячейки вверх, чтобы заполнить пробелы

Question

Я пытаюсь скопировать / вставить строки с одного листа на другой, если столбец B содержит «Complete». В столбце есть раскрывающийся список, поэтому я не знаю, влияет ли это на что-либо, но он не копирует / вставляет все строки в новую рабочую таблицу. Когда я запускаю его, переносятся только 4 из 7 строк, содержащих «Complete». Это код, который я использую:

Sub TransferComplete()
    Dim o As Range
    Dim p As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("In Progress")
    Set Target = ActiveWorkbook.Worksheets("Complete")

    p = 3     ' To Start copying to row 3 in target sheet
    For Each o In Source.Range("B3:B1000")   
        If o = "Complete" Then
           Source.Rows(o.Row).Copy Target.Rows(p)
           Source.Rows(o.Row).EntireRow.Delete
           p = p + 1
        End If
    Next o
End Sub

Я просто хочу, чтобы он автоматически переносил строки на новый лист, когда в раскрывающемся списке выбрано «Завершить». Любая помощь очень ценится!

Спасибо.

Answer 1

Если вы зацикливаете и удаляете, вам нужно l oop снизу вверх.

 Dim i as Long
 For i = 1000 to 3 Step -1
      If Source.Cells(i, "B").Value = "Complete" Then
           Source.Rows(i).Copy Target.Rows(p)
           Source.Rows(i).Delete
           p = p + 1
      End If
 Next 

Примечание: используйте Long вместо Integer. См. этот вопрос для подробного обсуждения почему.