VBA运行报1004错误提示复制粘贴区域大小不一致如何解决

错误原因 #

该报错本质是选中的复制区域和粘贴区域的行列数不匹配，你的代码触发该问题的常见诱因如下：

• NewRow变量取值小于14，导致复制区域的行范围反向，实际没有有效复制内容
• 复制代码中的Cells对象没有绑定所属工作表，默认取当前活动工作表的单元格，如果执行代码时活动工作表不是预期的源表，复制区域的实际大小会和预设值不符
• 目标工作表ws的粘贴位置存在合并单元格、隐藏行/列、处于筛选状态，会导致粘贴区域的可写入范围和复制区域大小不匹配

修复方案 #

方案1：修复引用逻辑后直接赋值（推荐，执行效率远高于复制粘贴） #

直接替换原有两行代码为以下内容，可完全避免区域不匹配问题：

Dim srcSheet As Worksheet
' 这里可以替换为你实际的源工作表，比如Set srcSheet = Sheets("数据页")
Set srcSheet = ActiveSheet

' 校验复制范围合法性
If NewRow < 14 Then
    MsgBox "结束行小于起始行，无有效数据可复制"
    Exit Sub
End If

' 定义复制区域
Dim copyRng As Range
Set copyRng = srcSheet.Range(srcSheet.Cells(14, 7), srcSheet.Cells(NewRow, 8))

' 直接对目标区域赋值，不需要走剪贴板
ws.Range("A1").Offset(rn, 6).Resize(copyRng.Rows.Count, copyRng.Columns.Count).Value = copyRng.Value

方案2：调整原有复制粘贴逻辑 #

如果你需要保留复制粘贴的格式等其他属性，按照以下逻辑修正：

• 给所有Cells对象显式绑定所属工作表，避免隐式引用活动表
• 粘贴前确认目标工作表已取消筛选、粘贴位置无合并单元格
  修正后的代码如下：

Dim srcSheet As Worksheet
Set srcSheet = ActiveSheet
If NewRow < 14 Then
    MsgBox "无有效复制区域"
    Exit Sub
End If
srcSheet.Range(srcSheet.Cells(14, 7), srcSheet.Cells(NewRow, 8)).Copy
ws.Range("A1").Offset(rn, 6).PasteSpecial xlPasteValues
' 清空剪贴板避免残留
Application.CutCopyMode = False

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