Question

下面的代码从特定列复制数据并将其传输到另一列。例如，如果在列A 中我有来自第1行到第10行的数据并按下按钮，那么第1行到第10行的值将转移到即 D栏。之后，如果我更改第A列中第5行，第7行和第9行中的值并按下按钮，则只会将第5行，第7行和第9行中的值传输到 D栏。代码之所以如此，是因为工作表中有许多行填充了值，而我希望仅传输（复制）已修改的值。否则，需要一段时间。

代码有效，但有时我会收到错误 commnand不能用于多个选择。我试着在互联网上查看它，但我无法提出任何解决方案。任何帮助将不胜感激！

注意：来自此社区的用户帮助我在不久前编写了代码，但我找不到该链接了。

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

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属性遍历范围的所有部分：

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）

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

1 个答案: