当日期出现在特定列中时，如何将源工作表的整行复制并粘贴到目标？

Question

我有一个标有“Key_Combination Management”（源）的工作表，用于跟踪 E:E 列中的撤销日期。我希望每当输入日期时，将与该日期相对应的整行复制并粘贴到另一个标记为“已撤销的主列表”（目的地）的工作表，然后从源中删除。我当前使用的代码允许任何时候 E:E 中的单元格输入数据时进行复制、粘贴和删除。我想限制为包含日期的单元格。

这是我目前正在使用的。我不知道如何让它只在源表上日期为 E:E 的单元格上执行。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target.Range("E:E") Then
        With Target.EntireRow
        .Copy Sheets("Revoked Master List").Cells(Sheets("Revoked Master List").Rows.Count, 1).End(xlUp).Offset(1, 0)
        .Delete
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End If
End Sub

Answer 1

这是一种处理方法：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, c As Range, v, ws As Worksheet, rngDel As Range
    
    Set rng = Application.Intersect(Target, Me.Range("E:E"))
    If rng Is Nothing Then Exit Sub
    
    On Error GoTo haveError 'make sure events are not left disabled if there's an error
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set ws = ThisWorkbook.Worksheets("Revoked Master List")
    For Each c In rng.Cells        'handling multi-cell updates
        If IsDate(c.Value) Then    'cell has date ?
            c.EntireRow.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
            BuildRange rngDel, c 'add cell to "delete" range
        End If
    Next c
    'any copied rows to delete?
    If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
    
haveError:
    If Err <> 0 Then Debug.Print Err.Description
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

'Add range `rngAdd` to range `rngTot`
Sub BuildRange(ByRef rngTot As Range, rngAdd As Range)
    If rngTot Is Nothing Then
        Set rngTot = rngAdd
    Else
        Set rngTot = Application.Union(rngTot, rngAdd)
    End If
End Sub

最好在最后删除所有复制的行，而不是复制时一一删除。