удалить всю строку, если ячейка G = "YES"

Question

Привет У меня есть код, чтобы удалить всю строку, если ячейка в столбце G = "ДА". Он работает нормально, но при копировании ячеек из одной рабочей книги в другую удаляется последняя вставленная строка. То же самое, как если бы я перетаскивал ячейку для автоматического заполнения.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
'If Cell that is edited is in column U and the value is completed then
If Target.Column = 7 And Target.Value = "YES" Then
    'Define last row on completed worksheet to know where to place the row of data
    LrowCompleted = Sheets("EQUIP. OFF RENT").Cells(Rows.Count, "A").End(xlUp).Row
    'Copy and paste data
    Range(Target.Row & ":" & Target.Row).Copy Sheets("EQUIP. OFF RENT").Range("A" & LrowCompleted + 1)
   End If
   If Target.Column = 7 And Target.Value = "YES" Then

    Range(Target.Row & ":" & Target.Row).Delete
    End If

Application.EnableEvents = True

Answer 1

После анализа вашего кода это классическая проблема с On Error Resume Next в сочетании с Application.EnableEvents = False.Даже если в коде есть ошибка, задание все еще выполняется.Вот почему последняя ячейка удаляется, например, после вставки.

Чтобы избежать этого, я просто удаляю сообщение об ошибке, следующее и enableevents, и добавляю эту строку перед первым оператором If:

If Target.Column = 1 Then Exit Sub

Пожалуйста, попробуйте это:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 1 Then Exit Sub

If Target.Column = 7 And Target.Value = "YES" Then
    'Define last row on completed worksheet to know where to place the row of data
    LrowCompleted = Sheets("EQUIP. OFF RENT").Cells(Rows.Count, "A").End(xlUp).Row
    'Copy and paste data
    Range(Target.Row & ":" & Target.Row).Copy Sheets("EQUIP. OFF RENT").Range("A" & LrowCompleted + 1)
End If
If Target.Column = 7 And Target.Value = "YES" Then
    Range(Target.Row & ":" & Target.Row).Delete
End If

End Sub