Range类PasteSpecial方法首次运行失败，二次运行正常的问题排查

问题场景 #

• 最初尝试将合并居中的A1:AG5区域复制到另一工作簿同大小区域，多种剪切粘贴方式均无效
• 调整方案后，改为从指定路径T:\Repeats\PNL_UPDATE.xlsx的Sheet1中，复制名为Text_1的A1:A5文本区域，到活动工作簿的CustQuote工作表A35:A39区域
• 异常情况：首次运行宏时触发Run-time error 1004: PasteSpecial Method of Range class failed，点击结束后再次运行宏，可成功完成复制，并正确设置A35:AG39区域为水平跨列居中、垂直居中

原代码 #

Option Explicit
Private Sub UpdateForm1_Click()

    'Dim wsActive As Worksheet
    'Set wsActive = ThisWorkbook.ActiveSheet
    Dim wbActive As Workbook
    Set wbActive = ThisWorkbook
    
    Dim Up_Location As String
    Dim Up_Name As String
    Up_Location = "T:\Repeats\"
    Up_Name = "PNL_UPDATE.xlsx"
    
    
 Application.ScreenUpdating = False
    Workbooks.Open Up_Location & Up_Name
        Worksheets("Sheet1").Activate
            ActiveSheet.Range("Text_1").Select
                ActiveSheet.Range("Text_1").Copy

    
    wbActive.Sheets("CustQuote").Unprotect Password:="1234"
    
    wbActive.Worksheets("CustQuote").Activate
    wbActive.Worksheets("CustQuote").Range("A35:A39").Select
    wbActive.Worksheets("CustQuote").Range("A35:A39").PasteSpecial xlPasteAll


    Range("A35:AG39").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .ReadingOrder = xlContext
    End With
    Range("E2").Select
    wbActive.Sheets("CustQuote").Protect Password:="1234"
    
    Application.CutCopyMode = False
    Windows("PNL_UPDATE.xlsx").Activate
    ActiveWorkbook.Close
 Application.ScreenUpdating = True

End Sub

错误根源 #

1. 过度依赖Select/Activate方法：这类操作会切换Excel的活动上下文，首次运行时可能因为上下文切换不及时，导致剪贴板内容丢失或粘贴目标区域未正确锁定
2. 未明确引用外部工作簿对象：打开外部工作簿后，仅通过ActiveSheet操作，容易出现对象引用混乱

修正后的代码 #

Option Explicit
Private Sub UpdateForm1_Click()
    Dim wbActive As Workbook
    Dim wsTarget As Worksheet
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim rngSource As Range
    Dim rngTarget As Range
    
    Set wbActive = ThisWorkbook
    Set wsTarget = wbActive.Worksheets("CustQuote")
    Set rngTarget = wsTarget.Range("A35:A39")
    
    Dim Up_Location As String
    Dim Up_Name As String
    Up_Location = "T:\Repeats\"
    Up_Name = "PNL_UPDATE.xlsx"
    
    Application.ScreenUpdating = False
    
    ' 打开源工作簿并明确引用对象
    Set wbSource = Workbooks.Open(Up_Location & Up_Name)
    Set wsSource = wbSource.Worksheets("Sheet1")
    Set rngSource = wsSource.Range("Text_1")
    
    ' 解锁目标工作表
    wsTarget.Unprotect Password:="1234"
    
    ' 直接复制粘贴，无需Select/Activate
    rngSource.Copy
    rngTarget.PasteSpecial xlPasteAll
    
    ' 设置格式，直接操作目标区域
    With wsTarget.Range("A35:AG39")
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .ReadingOrder = xlContext
    End With
    
    ' 锁定目标工作表
    wsTarget.Protect Password:="1234"
    
    ' 清理剪贴板并关闭源工作簿
    Application.CutCopyMode = False
    wbSource.Close SaveChanges:=False
    
    Application.ScreenUpdating = True
End Sub

关键修正点 #

• 移除所有Select/Activate操作，直接通过对象变量引用工作簿、工作表和单元格区域，避免上下文切换问题
• 明确声明并初始化源工作簿、工作表和区域对象，确保引用的准确性
• 关闭源工作簿时添加SaveChanges:=False，防止意外保存修改
• 操作格式时直接指定目标工作表的区域，避免依赖默认的活动工作表

内容的提问来源于stack exchange，提问作者Paul 'R'