Question

我的工作簿中有2张“Sheet1”和“Data”。在Sheet1中，我使用了Worksheet_Change宏，以便在C列中发生更改时：

时间戳显示在D列
该范围将被复制到“数据”表中。

这是我的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Location As Range
    If Target.Column > 3 Or Target.Column < 3 Then Exit Sub
    Application.EnableEvents = False
    Cells(Target.Row, 4) = Now
    Application.EnableEvents = True
    Selection.End(xlToLeft).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("data").Unprotect
    Sheets("data").Range("a1").End(xlDown).Offset(1, 0).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("data").Protect
    Range("a1").Select
End Sub

我的问题是PasteSpecial的工作时间不止一次。

Answer 1

不确定正在使用Selection进行复制的内容，这取决于您在C列中输入值的方式，无论是按Enter键还是按Ctrl + Enter键。假设您在B2中输入一个值并按Enter键提交它，将选择单元格B3，并根据您的代码将第3行的范围复制到数据表。而如果按Ctrl + Enter，则选择将保留在B2中，因此第2行的范围将复制到数据表。但是你可以自己调整一下。

查看调整后的代码是否适合您。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Location As Range
If Target.Column <> 3 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
Cells(Target.Row, 4) = Now
Application.EnableEvents = True
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlToRight)).Select
Sheets("data").Unprotect
Selection.Copy
Sheets("Data").Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
Sheets("data").Protect
Range("a1").Select
Application.ScreenUpdating = True
End Sub

Answer 2

问题是取消保护工作表正在清除剪贴板，这意味着没有任何东西可以粘贴！这里是改编的代码，我也通过其他几种方式进行了改进，以大大改进它，详见评论。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Location As Range
    ' Use <> to mean "not equal to"
    If Target.Column <> 3 Then Exit Sub
    Application.EnableEvents = False
    ' Fully qualify the cells object
    ThisWorkbook.Sheets("Sheet1").Cells(Target.Row, 4).Value = Now
    Application.EnableEvents = True
    ' Avoid using .Select and Selection, the user could have clicked anywhere after the value change
    ' Use a With block to fully qualify your range objects
    With ThisWorkbook.Sheets("data")
        .Unprotect
        ' Copy immediately before paste
        Target.EntireRow.Copy
        .Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        .Protect
    End With
    Application.CutCopyMode = False
End Sub

目前，这只会覆盖“数据”表上的同一行，因为您要粘贴的数据在A列中没有任何内容，因此A列中的End(xlDown)返回相同的位置。您可能需要将其更改为C列，或使用

.Cells(Rows.Count,"C").End(xlUp).Offset(1, 0).PasteSpecial

哪个仍然依赖于列但是最后一行才能获得。 .之前有一个点Cells，因为该行位于With块内。

粘贴特殊不工作超过1次：VBA

2 个答案: