如何将Excel工作表图表复制到其余工作表且自动引用所在工作表数据

你原来使用CopyPicture是将图表转为静态图片，自然无法联动数据，即使直接复制图表对象，默认也会保留对原工作表Dec 1的数据源引用，复制后手动修改数据源指向当前工作表即可实现需求。

完整修改后代码 #

Public Sub CopyDataAndCharts()
    Dim vRange As Variant
    Dim srcWs As Worksheet, targetWs As Worksheet
    Dim srcChart As ChartObject
    Dim newChart As ChartObject
    Dim ser As Series
    Dim i As Integer
    
    ' 定义源工作表和源图表
    Set srcWs = ThisWorkbook.Worksheets("Dec 1")
    Set srcChart = srcWs.ChartObjects("Chart 1")
    ' 读取源数据
    vRange = srcWs.Range("A53:F100")
    
    ' 遍历所有目标工作表（从第5个工作表开始，和原有逻辑保持一致）
    For i = 5 To ThisWorkbook.Worksheets.Count
        Set targetWs = ThisWorkbook.Worksheets(i)
        ' 复制数据到目标工作表
        targetWs.Range("A53:F100").Value = vRange
        
        ' 复制可编辑图表对象到目标工作表A2位置
        srcChart.Copy Destination:=targetWs.Range("A2")
        Set newChart = targetWs.ChartObjects(1)
        
        ' 遍历图表所有数据系列，修改数据源指向当前目标工作表
        For Each ser In newChart.Chart.SeriesCollection
            ' 两种替换规则适配带引号/不带引号的工作表名称引用格式
            ser.Formula = Replace(ser.Formula, "'" & srcWs.Name & "'", "'" & targetWs.Name & "'")
            ser.Formula = Replace(ser.Formula, srcWs.Name & "!", targetWs.Name & "!")
        Next ser
    Next i
    
    ' 释放对象避免内存残留
    Set ser = Nothing
    Set newChart = Nothing
    Set srcChart = Nothing
    Set targetWs = Nothing
    Set srcWs = Nothing
End Sub

关键修改说明 #

• 替换了CopyPicture方法：改用ChartObject.Copy直接复制可编辑的图表对象，而非静态图片
• 增加数据源适配逻辑：遍历复制后图表的所有数据系列，把系列公式中对源工作表Dec 1的引用全部替换为当前目标工作表的名称，实现图表自动读取所在工作表的对应数据
• 保留原有遍历逻辑：和之前复制数据的遍历规则一致，仅处理第5个及之后的所有工作表
• 增加对象释放逻辑：避免VBA运行残留内存占用

注意事项 #

• 如果你的图表有标题或者其他引用了原工作表单元格的元素，可以对应增加替换逻辑即可
• 如果目标工作表原本就有其他图表，可通过指定newChart的名称避免索引错误

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