VBA复制多列时出现Range Memory Overflow问题求助

你的宏报错并非剪贴板内存问题，而是Range地址字符串长度超出了VBA的限制。当拼接的列范围地址过长（超过约255字符），VBA无法解析这个长字符串，导致运行错误。另外原代码存在小语法错误：Dim sourceWs1, dstWsDiff1, As Worksheet里的多余逗号会让前两个变量被声明为Variant类型，而非Worksheet，需要修正。

以下是两种可行的解决方案：

方案一：使用Union合并区域（保留完整复制内容） #

通过Union方法逐个合并需要复制的列区域，避免生成过长的地址字符串，同时保留复制格式、公式等完整内容的能力：

Sub CopyValuesDiff()
    Dim sourceWs1 As Worksheet, dstWsDiff1 As Worksheet
    Dim dtToday As String
    Dim copyRange As Range
    
    dtToday = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
    Set sourceWs1 = Sheets("Size_1")
    Set dstWsDiff1 = Sheets("Diff_1")
    
    ' 初始化并逐个添加要复制的列区域到Union集合
    Set copyRange = sourceWs1.Range("H6:H300")
    Set copyRange = Union(copyRange, sourceWs1.Range("J6:J300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("L6:L300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("N6:N300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("AF6:AF300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("AH6:AH300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("AJ6:AJ300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("AL6:AL300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("BD6:BD300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("BF6:BF300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("BH6:BH300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("BJ6:BJ300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("CB6:CB300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("CD6:CD300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("CF6:CF300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("CH6:CH300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("CZ6:CZ300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("DB6:DB300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("DD6:DD300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("DF6:DF300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("DX6:DX300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("DZ6:DZ300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("EB6:EB300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("ED6:ED300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("EV6:EV300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("EX6:EX300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("EZ6:EZ300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("FB6:FB300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("FT6:FT300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("FV6:FV300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("FX6:FX300"))
    Set copyRange = Union(copyRange, sourceWs1.Range("FZ6:FZ300"))
    
    copyRange.Copy Destination:=dstWsDiff1.Range("B2")
    
    dstWsDiff1.Range("A3").Value = dtToday
    Application.CutCopyMode = False
End Sub

方案二：直接赋值（仅复制值，效率更高） #

如果只需要复制单元格的值（不需要格式、公式等），可以跳过剪贴板直接赋值，这种方法不仅避免地址长度问题，还能提升运行效率：

Sub CopyValuesDiff()
    Dim sourceWs1 As Worksheet, dstWsDiff1 As Worksheet
    Dim dtToday As String
    Dim colList As Variant
    Dim i As Integer
    Dim srcCol As Range, dstCol As Range
    
    dtToday = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
    Set sourceWs1 = Sheets("Size_1")
    Set dstWsDiff1 = Sheets("Diff_1")
    
    ' 存储需要复制的列名数组
    colList = Array("H", "J", "L", "N", "AF", "AH", "AJ", "AL", _
                    "BD", "BF", "BH", "BJ", "CB", "CD", "CF", "CH", _
                    "CZ", "DB", "DD", "DF", "DX", "DZ", "EB", "ED", _
                    "EV", "EX", "EZ", "FB", "FT", "FV", "FX", "FZ")
    
    ' 循环逐个列复制值
    For i = LBound(colList) To UBound(colList)
        Set srcCol = sourceWs1.Range(colList(i) & "6:" & colList(i) & "300")
        ' 目标列从B开始，对应数组索引依次往后
        Set dstCol = dstWsDiff1.Range(Chr(66 + i) & "2:" & Chr(66 + i) & "296")
        dstCol.Value = srcCol.Value
    Next i
    
    dstWsDiff1.Range("A3").Value = dtToday
End Sub

内容的提问来源于stack exchange，提问作者mjac