时间戳

首页 > 解决方案 > 复制和粘贴无意中触发 Worksheet_Change sub

vba - 复制和粘贴无意中触发 Worksheet_Change sub

问题描述

当列“P”取值“x”时，我遇到了“Worksheet_Change”子问题，该子将整行复制并粘贴到第二个工作表（“已完成”）中。它的内容如下：

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
    Application.EnableEvents = False
    'If Cell that is edited is in column P and the value is x then
    If Target.Column = 16 And Target.Value = "x" Then
        'Define last row on completed worksheet to know where to place the row of data
        LrowCompleted = Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Row
        'Copy and paste data
        Range("A" & Target.Row & ":P" & Target.Row).Copy Sheets("Completed").Range("A" & LrowCompleted + 1)
        'Delete Row from Project List
        Range("A" & Target.Row & ":P" & Target.Row).Delete xlShiftUp
    End If
    Application.EnableEvents = True
End Sub

子程序本身工作正常，但如果我在工作表中的任何位置复制和粘贴，子程序就会被激活，并且我粘贴的行会发送到我的“已完成”工作表。

到目前为止，我一直在玩“if-clause”，但没有任何运气。例如：

    If Not Target.Column = 16 And Target.Value = "x" Is Nothing Then

我担心我错过了显而易见的事情，我很感激任何帮助。

谢谢并恭祝安康

PMHD

标签： vbaexcelexcel-2013

解决方案

谢谢，吉普德。

由于 Target 引用了多个单元格，因此出现了问题。通过排除 Target.Count > 1 的情况来修复它。

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
'Exclude all cases where more than one cell is Target
If Target.Count > 1 Then

'If Cell that is edited is in column P and the value is x then
ElseIf Target.Column = 16 And Target.Value = "x" Then
    'Define last row on completed worksheet to know where to place the row of data
    LrowCompleted = Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Row
    'Copy and paste data
    Range("A" & Target.Row & ":P" & Target.Row).Copy Sheets("Completed").Range("A" & LrowCompleted + 1)
    'Delete Row from Project List
    Range("A" & Target.Row & ":P" & Target.Row).Delete xlShiftUp
End If
Application.EnableEvents = True
End Sub

推荐阅读