vba - 运行时错误 1004 - 该命令不能用于多项选择

Question

下面的代码从特定列复制数据并将其传输到另一列。例如，如果在 A栏我有来自 的数据第 1 至 10 行 并按下按钮，然后从第 1 行到第 10 行的值将被传输到即 D栏 .之后，如果我更改 中的值A 列中的第 5、7 和 9 行 并按下按钮，只有 中的值第 5、7 和 9 行 将转至 D栏 .代码是这样的原因是因为工作表有很多行填充了值，我只想传输(复制)已修改的值。否则，将需要相当长的时间。

代码有效，但有时我收到错误 该命令不能用于多选 .我试图在互联网上查看以修复它，但我无法提出任何解决方案。任何帮助将不胜感激!

备注 : 这个社区的一位用户前段时间帮我写了下面的代码，但我再也找不到那个链接了。

此代码粘贴在我正在使用的工作表中:

Option Explicit
Private Sub Worksheet_Change(ByVal target As Range)

    Dim creation As Worksheet
    Set creation = ActiveSheet

    Dim copydata As Range
    Set copydata = Application.Intersect(target, creation.Range("A2:A5000", "A" & creation.Rows.Count))

    If (Not copydata Is Nothing) Then
        If (CopyDataRange Is Nothing) Then
            Set CopyDataRange = copydata
        Else
            Set CopyDataRange = Application.Union(CopyDataRange, copydata)
        End If
    End If
End Sub 

这段代码粘贴在一个模块中:

Option Explicit

Public CopyDataRange As Range

Public Sub CommandButton1_Click()

    Application.ScreenUpdating = False

    If (Not CopyDataRange Is Nothing) Then
        CopyDataRange.Copy
        CopyDataRange.Offset(0, 3).PasteSpecial Paste:=xlPasteValues   ' this where I get the error
     Set CopyDataRange = Nothing

    End If
    Application.ScreenUpdating = True
End Sub

Answer 1

PasteSpecial不适用于多个范围。您可以使用 Areas 循环遍历范围的所有部分。属性(property):

if Not CopyDataRange Is Nothing then
    Dim r As Range
    For Each r In CopyDataRange.Areas
        r.Copy
        r.Offset(0, 3).PasteSpecial Paste:=xlPasteValues   
    Next
    set CopyDataRange = nothing
end if 

即使您没有多个范围，这也会起作用，在这种情况下，它只包含一个 Area ( Areas.Count = 1)