如何用VBA为每个数据系列创建独立的Chart Sheet？

以下是结合你两段代码功能的解决方案，能循环为每个地区生成独立的图表工作表（Chart Sheet）：

Sub CreateRegionChartSheets()
    Dim dataSheet As Worksheet
    Dim lastRow As Long
    Dim colIndex As Integer
    Dim regionChart As Chart
    Dim regionName As String
    
    ' 指定数据所在的工作表，替换为你的实际表名
    Set dataSheet = ThisWorkbook.Worksheets("Data_Source")
    ' 获取年份列的最后一行数据
    lastRow = dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row
    
    ' 遍历所有地区列（从第2列到最后一个有表头的列）
    For colIndex = 2 To dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft).Column
        ' 获取当前地区名称
        regionName = dataSheet.Cells(1, colIndex).Value
        
        ' 创建新的Chart Sheet
        Set regionChart = Charts.Add
        ' 设置图表类型为折线图（可按需修改为xlColumnClustered等）
        regionChart.ChartType = xlLine
        
        ' 为图表添加对应地区的数据系列
        With regionChart.SeriesCollection.NewSeries
            .Name = regionName
            ' X轴绑定年份数据
            .XValues = dataSheet.Range(dataSheet.Cells(2, 1), dataSheet.Cells(lastRow, 1))
            ' Y轴绑定当前地区的数值数据
            .Values = dataSheet.Range(dataSheet.Cells(2, colIndex), dataSheet.Cells(lastRow, colIndex))
        End With
        
        ' 将Chart Sheet命名为地区名称，处理重名报错
        On Error Resume Next
        regionChart.Name = regionName
        On Error GoTo 0
    Next colIndex
End Sub

关键说明 #

1. 避免ActiveSheet依赖：直接指定数据工作表对象，防止因切换工作表导致的引用错误，比原代码更稳定。
2. 自适应列范围：自动识别最后一个有数据的地区列，不用硬写列号，适配数据列增减的场景。
3. 解决原代码报错问题：放弃原第一段代码的SetSourceData方式，改用SeriesCollection.NewSeries单独指定X/Y轴数据，避免了范围引用不匹配导致的报错。
4. 处理重名情况：加入错误捕获逻辑，防止重复创建同名Chart Sheet时程序崩溃。

使用步骤 #

1. 按Alt+F11打开VBA编辑器
2. 插入新模块，粘贴上述代码
3. 修改dataSheet = ThisWorkbook.Worksheets("Data_Source")中的表名为你的实际数据工作表名称
4. 运行该宏即可生成所有地区的独立Chart Sheet

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