ActiveSheet.Paste Link:=True随机报1004错误：无粘贴链接的技术求助

我需要处理多个原始数据文件，通过宏循环将每个文件的数据导入xlsm模板的对应工作表做计算分析，最终得到一个包含所有原始数据对应工作表的xlsm文件。同时基于结果模板生成xlsx结果文件，其中每行数据和图表曲线都要链接回xlsm原工作表，确保xlsm中的修改能同步到结果文件。

Sub AssembleResults()
'// Subroutine goes through every list in Workbook and copies row of results and graph to Resuls file

    Dim SingleSheet As Worksheet
    Dim wksSource As Worksheet, 
    Dim wksDest As Worksheet    
    Dim rngSource, rngDest As Range            
    Dim chrtSource As ChartObject, chrtDest As Chart          
    
    '// Open Results template
    Application.DisplayAlerts = True   
    Workbooks.Open FileName:=XltResults, Editable:=True
    Set wbResults = ActiveWorkbook
    Application.DisplayAlerts = False
    
    For Each SingleSheet In wbTemplate.Worksheets      
        '//wbTemplate is berofe defined and used xlsm file with Worksheets

        Set wksSource = wbTemplate.Worksheets(SingleSheet.Name)
        Set rngSource = wksSource.Range("A3:L3")
        Set chrtSource = wksSource.ChartObjects(2)
            
        wbResults.Worksheets("Results").Activate
        Set wksDest = ActiveSheet
        Set rngDest = wksDest.Range(Range("A1").End(xlDown).Offset(-1,0),Range("L1").End(xlDown).Offset(-1,0))
        
        Set chrtDest = wbResults.Charts(1)
            
        '//Copying row of results
        rngSource.Copy
        wbResults.Activate   
        wksDest.Activate     
        rngDest.Select
        ActiveSheet.Paste Link:=True          '//HERE IS THE PROBLEM
        Application.CutCopyMode = False
          
        '//Copying lines of graph into single graph
        chrtSource.Activate
        chrtSource.Copy  
        wbResults.Activate
        chrtDest.Select
        chrtDest.Paste    
        Application.CutCopyMode = False
        
        '// Cleaning the variables
        Set wksSource = Nothing
        Set wksDest = Nothing
        Set rngSource = Nothing
        Set rngDest = Nothing
        Set chrtSource = Nothing
        Set chrtDest = Nothing

End Sub

在标记的ActiveSheet.Paste Link:=True代码行，宏会随机抛出错误：

Run-time Error'1004': No Link to Paste

进入调试模式后按F5继续运行，又能无问题执行随机次数的循环。错误完全无规律：部分数据批次运行无错，部分批次报错多次；同一批次多次运行，可能无错也可能在任意循环步骤停止。

1. 彻底移除Activate/Select操作（核心修复） #

Excel VBA中依赖Activate和Select会导致对象引用不稳定，这是随机错误的主要诱因。直接通过对象引用操作工作表和单元格，无需激活/选择。

2. 修正变量声明与单元格范围获取 #

• 修复变量声明的语法错误（避免Variant类型隐式转换）
• 修正目标单元格范围的获取逻辑，确保定位到下一个空行而非依赖End(xlDown)的不稳定结果

3. 添加缓存同步机制 #

复制后调用DoEvents，让Excel完成剪贴板缓存的写入，避免粘贴时缓存未就绪。

修正后的完整代码 #

Sub AssembleResults()
'// Subroutine goes through every sheet in template workbook, copies result row and chart to Results file with links

    Dim SingleSheet As Worksheet
    Dim wksSource As Worksheet
    Dim wksDest As Worksheet    
    Dim rngSource As Range, rngDest As Range            
    Dim chrtSource As ChartObject, chrtDest As Chart
    Dim wbResults As Workbook '// 显式声明变量
    
    '// Open Results template
    Application.DisplayAlerts = True   
    Set wbResults = Workbooks.Open(Filename:=XltResults, Editable:=True)
    Application.DisplayAlerts = False
    
    '// 定位结果工作表，无需激活
    Set wksDest = wbResults.Worksheets("Results")
    Set chrtDest = wbResults.Charts(1)
    
    For Each SingleSheet In wbTemplate.Worksheets      
        Set wksSource = wbTemplate.Worksheets(SingleSheet.Name)
        Set rngSource = wksSource.Range("A3:L3")
        Set chrtSource = wksSource.ChartObjects(2)
            
        '// 获取目标空行：从A列最后一行向上找非空行，再下移一行
        Set rngDest = wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 12) '// 12列对应A-L
            
        '// 复制并粘贴链接，无需激活/选择
        rngSource.Copy
        DoEvents '// 等待剪贴板就绪
        rngDest.PasteSpecial Link:=True
        Application.CutCopyMode = False
          
        '// 复制图表并粘贴到目标图表（保留数据链接）
        chrtSource.Chart.ChartArea.Copy
        DoEvents
        chrtDest.Paste
        Application.CutCopyMode = False
        
        '// 清理变量
        Set wksSource = Nothing
        Set rngSource = Nothing
        Set chrtSource = Nothing

    Next SingleSheet '// 原代码缺失Next语句，补上
    
    '// 最终清理
    Set wksDest = Nothing
    Set chrtDest = Nothing
    Set wbResults = Nothing

End Sub

额外注意事项 #

• 确保wbTemplate和XltResults变量在宏的其他部分已正确定义并指向对应的工作簿/文件路径
• 原代码缺失Next SingleSheet语句，会导致循环无法正常结束，已在修正代码中补上
• 图表粘贴时，复制ChartArea而非整个ChartObject，能更好地保留数据链接关系

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