Excel Paste Special宏运行PasteSpecial报1004运行时错误求助

问题背景 #

编写了用于实现跨工作表复制粘贴的Excel Paste Special宏，预期功能为将Sheet1中F1单元格的值复制到Sheet2的A列首个空白单元格，原宏代码如下：

Sub Copy_Cell2()

'Declare Variables
    Dim Wr As Worksheet

'Define the excel sheet

    Set Wr = ThisWorkbook.Sheets("Sheet2")

'Code to stop screen updating and flickering ON

    Application.ScreenUpdating = False

'Select Sheet1 to get the random value

    Sheets("Sheet1").Select
    Cells.Select
    Range("F1").Select
    Range("F1").Copy

'Selects Sheet2 to paste the random value in the next blank cell in column A

    Sheets("Sheet2").Select

    Range("A2").Select

    nrlife = Wr.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select

'Establish what row has been selected

    With ActiveCell

    vRow = .Row

    End With

    vRange = "A" & vRow & ""

    Range(vRange).Select

'Code to paste value and format from Sheet1 to first empty row on sheet2
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks_:=False, Transpose:=False

'Code to stop screen updating and flickering OFF

    Application.ScreenUpdating = True

End Sub

运行该宏时，执行到Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks_:=False, Transpose:=False代码行时触发报错，错误提示为Run-time error '1004' Application-defined or object-defined error（运行时错误1004：应用程序定义或对象定义错误）。

错误原因排查 #

触发1004错误的直接原因+代码潜在问题如下：

• 核心语法错误：SkipBlanks_参数名末尾多了多余的下划线。VBA中参数末尾加下划线是换行续行的标记，正确的参数名是SkipBlanks，拼写错误会导致方法无法识别传入参数，直接抛出运行时错误。
• 冗余的选中操作：代码中反复使用Select选中工作表、单元格，不仅运行效率低，还容易因为选中状态变化导致剪贴板内容丢失、对象引用错位。
• 变量未显式声明：nrlife、vRow、vRange三个变量均未提前声明类型，容易出现隐式类型转换错误。
• 目标单元格定位逻辑冗余：通过多次选中单元格、取活动单元格行号、拼接地址再选中的方式找空白单元格，逻辑绕路且容易出错。
• 缺少错误兜底：如果代码运行中途报错，Application.ScreenUpdating = False不会被重置为True，会导致Excel界面停止刷新，影响正常操作。

修复后代码 #

Sub Copy_Cell2()
    ' 声明变量
    Dim Wr As Worksheet
    Dim targetCell As Range
    
    ' 关闭屏幕更新，绑定错误处理兜底
    Application.ScreenUpdating = False
    On Error GoTo ErrorHandler

    ' 绑定目标工作表
    Set Wr = ThisWorkbook.Sheets("Sheet2")
    
    ' 直接定位Sheet2 A列首个空白单元格，无需选中操作
    Set targetCell = Wr.Cells(Wr.Rows.Count, "A").End(xlUp).Offset(1, 0)
    
    ' 直接赋值实现值复制（稳定性远高于剪贴板粘贴，不会出现剪贴板丢失问题）
    targetCell.Value = ThisWorkbook.Sheets("Sheet1").Range("F1").Value
    
    ' 如果确实需要使用PasteSpecial方法（比如需要同时复制格式），可替换为以下修正后的写法
    ' ThisWorkbook.Sheets("Sheet1").Range("F1").Copy
    ' targetCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ' Application.CutCopyMode = False

ExitSub:
    ' 恢复屏幕更新，清空剪贴板
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    Exit Sub

ErrorHandler:
    MsgBox "运行出错：" & Err.Description, vbCritical
    Resume ExitSub
End Sub

关键修正说明 #

• 删除了SkipBlanks参数后多余的下划线，保证方法参数可被VBA正确识别
• 移除了所有不必要的Select操作，直接通过工作表对象定位、操作单元格，从根源避免选中状态变化导致的各类异常
• 补充了所有变量的显式声明，避免隐式类型错误
• 增加错误处理逻辑，无论代码是否运行出错，都会自动恢复Excel的屏幕刷新状态
• 优先使用单元格直接赋值的方式替代剪贴板粘贴，运行速度更快、稳定性更高，不会出现剪贴板内容被其他程序占用导致的粘贴失败问题

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