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

问题描述：

我在我的工作簿中有两张纸，“Sheet1”和“Data”。在Sheet我使用了Worksheet_Change宏，这样，当在C列中的改变发生的情况：粘贴特殊不工作超过1次：VBA

时间戳显示在列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工作不超过一次。

答

不确定正在使用“选择”来复制什么内容，取决于您在列C中输入值的方式，无论是按Enter还是Ctrl + Enter。说如果您在B2中输入一个值并按Enter键提交它，单元格B3将被选中，并且根据您的代码，从第3行开始的范围将被复制到数据表。而如果您按Ctrl + Enter，选择将保留在B2中，因此从row2开始的范围将被复制到数据表。但你可以调整自己。

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

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

除非在“数据”表单中也有表单更改代码，否则不需要粘贴“EnableEvents”标志... – Wolfie

好抓Wolfie！ :) – sktneer

谢谢你们，非常感谢， –

答

的问题是，取消保护板是清除剪贴板，这意味着没有什么可以贴！这里是改编的代码，我也改变了其他几种方法来大幅改进它，请参阅评论以获取详细信息。

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列，所以在列End(xlDown) A返回相同的位置。您可能需要将其更改为C列，或使用

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

仍然是列依赖，但上升到拿到最后一排。在Cells之前有一个点.，因为该线将位于With块内。

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

相关推荐