Excel 复制范围时出现类型不匹配错误。

我正试图使这项工作，但它说

类型不匹配

。我做错了什么有什么帮助吗？（我对此很陌生）

Sub-Copy\u-paste\u-XP（）
将wsI设置为工作表
调暗aCell作为范围，rng从作为范围复制，rng作为范围
暗淡的光线和长的一样
设置wsI=ThisWorkbook.Sheets（“移动容器XP”）
设置rng=（“E2:E500”）
对于rng中的每个aCell
如果Len（Trim（aCell.Value））为0，则
如果rngCopyFrom为空，则
设置rngCopyFrom=aCell
其他的
设置rngCopyFrom=Union（rngCopyFrom，aCell）
如果结束
如果结束
下一个
如果不是rngCopyFrom，则rngCopyFrom.Copy为空
范围（“K2”）。选择
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，SkipBlank_
：=假，转置：=假
设置rng=（“F2:F500”）
对于rng中的每个aCell
如果Len（Trim（aCell.Value））为0，则
如果rngCopyFrom为空，则
设置rngCopyFrom=aCell
其他的
设置rngCopyFrom=Union（rngCopyFrom，aCell）
如果结束
如果结束
下一个
如果不是rngCopyFrom，则rngCopyFrom.Copy为空
范围（“K501”）。选择
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，SkipBlank_
：=假，转置：=假
端接头

---

E2:E500首先，您没有正确设置变量。当设置rng=wsI.Range（“E2:E500”）时，您使用了

Set rng=（“E2:E500”）

此外，可以使宏更灵活。以下代码应该可以工作：

Sub CopyNotZero(SrcRng As Range, DestRng As Range)
    Dim Cell As Range, RngToCopy As Range
    For Each Cell In SrcRng
        If Cell.Value <> 0 And Len(Cell.Value) <> 0 Then
            If RngToCopy Is Nothing Then
                Set RngToCopy = Cell
            Else
                Set RngToCopy = Union(RngToCopy, Cell)
            End If
        End If
    Next Cell
    If Not RngToCopy Is Nothing Then
        RngToCopy.Copy
        DestRng.PasteSpecial xlPasteValues
    End If
    Set RngToCopy = Nothing
End Sub

这将跳过所有具有

0

值或根本没有值的单元格

屏幕截图：

设置：

运行

Test（）后的结果。

：

希望这有帮助

编辑：

要在每次粘贴到

$A$2

时调用此宏，以下代码将起作用（相应修改）：

---

希望这能有所帮助。

哪一行在抛出错误时突出显示？另外，我看到您在本质上重复了两次代码。你能解释一下你想做什么吗？我相信有一种更有效的方法。：）哪一行的

类型不匹配

？子副本粘贴重置

rngCopyFrom。在开始下一个循环之前，添加此行
Set rngCopyFrom=Nothing
。如果不是，则
rngCopyFrom
将包含触发错误的
E2:E500
和
F2:F500
范围地址。你不能复制多个选择。只是好奇。。。为什么下一步继续出错？@SiddharthRout:Oops。还有，忘了什么。现在编辑。如果
RngToCopy
为空，则
RngToCopy.Copy DestRng
也将失败。您需要额外的检查
如果不是rngCopyFrom是Nothing，则RngToCopy.Copy destrong
谢谢您指出这一点。忘记了他也需要值，所以我将上面的更改为使用
PasteSpecial
，而不仅仅是
Paste
：）+1现在一切都好了：）
Set RngToCopy=Nothing
也可以在IF/Endif；中移动）哈哈，是的。您的方法对我有效，除了出于某些原因它复制0，以及出于某些其他原因它粘贴在K和L中。
Set rng = wsI.Range("E2:E500")

Sub CopyNotZero(SrcRng As Range, DestRng As Range)
    Dim Cell As Range, RngToCopy As Range
    For Each Cell In SrcRng
        If Cell.Value <> 0 And Len(Cell.Value) <> 0 Then
            If RngToCopy Is Nothing Then
                Set RngToCopy = Cell
            Else
                Set RngToCopy = Union(RngToCopy, Cell)
            End If
        End If
    Next Cell
    If Not RngToCopy Is Nothing Then
        RngToCopy.Copy
        DestRng.PasteSpecial xlPasteValues
    End If
    Set RngToCopy = Nothing
End Sub

Sub Test()
    Dim wsI As Worksheet: Set wsI = ThisWorkbook.Sheets("Move containers XP")
    With wsI
        CopyNotZero .Range("E1:E500"), .Range("K2")
        CopyNotZero .Range("F1:F500"), .Range("K501")
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$2" Then
        CopyNotZero Range("A1:A500"), Range("K2")
    End If
End Sub