Новый график на каждом листе

Я пытаюсь добавить новый график на каждый лист, основываясь на некоторой информации, которую у меня уже есть. Однако в итоге у меня есть только один лист с диаграммой для последней информации. Я думаю, что диаграммы переписываются.

Вот код

Dim chart1 As chart Set chart1 = Charts.Add For i = 0 To 9 chart1.Add.SetSourceData Source:=Destino.Range("A24").Offset(0, 3 * i).CurrentRegion, PlotBy:=xlRows chart1.ChartType = xlBarClustered ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="gráfico" & i + 1 With ActiveChart .HasTitle = True .ChartTitle.Characters.Text = "Cuenta por categoría de" & origen.[c4].Offset(i, 0) .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Categoría" .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Frecuencia" End With ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count) Next 

В вашем примере вы объявляете и устанавливаете объект Chart вне цикла. Таким образом, это один и тот же экземпляр диаграммы на каждой итерации цикла, и он существенно перегружается или, точнее, обновляется.

Попробуйте переместить их внутри цикла и объявите объект Charts как новый. Теперь каждый раз, когда он увеличивается, он генерирует новый экземпляр диаграммы. В противном случае все выглядит хорошо.

 For i = 0 To 9 Dim chart1 As New Chart Set chart1 = Charts.Add chart1.Add.SetSourceData Source:=Destino.Range("A24").Offset(0, 3 * i).CurrentRegion, PlotBy:=xlRows chart1.ChartType = xlBarClustered ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="gráfico" & i + 1 With ActiveChart .HasTitle = True .ChartTitle.Characters.Text = "Cuenta por categoría de" & origen.[c4].Offset(i, 0) .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Categoría" .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Frecuencia" End With ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count) Next 
Давайте будем гением компьютера.