Ошибка 13, несоответствие типов после удаления строки в Worksheet_Change

Question

У меня есть таблица Excel с двумя листами.В sheet1 у меня есть несколько строк, каждая с раскрывающимся списком, который используется для установки статуса строки.Если статус изменяется на «Завершено» или «На удержании», его следует удалить из листа1 и переместить в следующую доступную строку в листе 2.

Однако после его удаления из листа1 я получаю

Ошибка времени выполнения 13 - несоответствие типов

Ниже приведен скриншот выделенного кода, ссылка на снимок экрана с ошибкой, снимок экрана sheet1 и выделенный код отладки.

https://youtu.be/7xbinC6meHw

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    Set KeyCells = Range("B:B")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

            If (Target.Value = "Complete" Or Target.Value = "On Hold") Then
                ActiveCell.EntireRow.Copy
                Worksheets("Sheet2").Activate
                i = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
                Worksheets("Sheet2").Cells(i + 1, 1).Select
                ActiveSheet.Paste
                Worksheets("Sheet1").Activate
                ActiveCell.EntireRow.Delete
            End If

    End If
End Sub

Answer 1

Это общая проблема для Worksheet_Change -программ, которые изменяют сам лист - это вызовет новый Change -Event (В этом втором событии target - это полная строка, которая в данный момент удалена, и проверяется значениеa Диапазон с более чем одной ячейкой вызовет эту ошибку 13).

Такие проблемы легко предотвратить: вы должны отключить события во время работы подпрограммы обработки событий.

Обновление : изменен код, чтобы показать, как использовать Copy без Select

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Application.EnableEvents = False  ' Disable events while routine is doing its duty
    On Error Goto ChangeExit          ' Ensure that events are switched on in any case

    Set KeyCells = Range("B:B")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

        With Target.Cells(1, 1)
            If (.Value = "Complete" Or .Value = "On Hold") Then
                Dim lastRow As Long
                lastRow = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).row

                .EntireRow.Copy Worksheets("Sheet2").Cells(lastRow + 1, 1)
                .EntireRow.Delete
            End If
        End With
    End If
ChangeExit:
    Application.EnableEvents = True
End Sub