Agregar series automáticamente a Gráfica

Buen dia estimado experto

Tengo un código macro el cual se utiliza en una hoja de cálculo en donde están las columnas Polígono, Vértice, X , Y. Pues bien, la macro crea una gráfica de dispersión (xy) que contiene una cantidad de series igual al número de polígonos que tiene dicha hoja.

Mi problema surge, que tengo que agregar una nueva tabla (con el mismo formato de la primera) a 5 columnas separada de la primera y no logro encontrar que debo modificar en el código para que se agreguen los nuevos polígonos al gráfico.

Paso a dejar el código que estoy utilizando

Desde ya muchas gracias por su ayuda.

Saludos

Sub prueba()
 Dim p As Range
 Dim poligono As Excel.Chart
 Dim serie_p As Excel.Series
 With ActiveSheet
 'Se crea un gráfico y lo asigna a la variable polígono
 Set poligono = .ChartObjects.Add(Left:=100, Width:=375, Top:=75, Height:=225).Chart
 'Se establece el tipo de gráfico
 poligono.ChartType = xlXYScatterLines
 'El rango de datos con el que se va a trabajar
 With .Range("a1").CurrentRegion
 'Desactiva la actualización de pantalla
 Application.ScreenUpdating = False
 'Se filtran los valores únicos de la columna 1 del rango de datos
 'con el que se va a trabajar
 .Columns(1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
 'Se inicia un bucle que va a recorrer todos los valores únicos
 'de la columna 1 del rango con el que se está trabajando
 For Each p In .Offset(1).Resize(.Rows.Count - 1).Columns(1).SpecialCells(xlCellTypeVisible)
 'Se crea una nueva serie y se asigna a la variable serie_p
 Set serie_p = poligono.SeriesCollection.NewSeries
 'Se filtran los datos por el valor con el que se
 'está trabajando
 .AutoFilter field:=1, Criteria1:=p
 'El rango de datos excluyendo los encabezados
 With .Offset(1).Resize(.Rows.Count - 1)
 'Se asigna el nombre a la nueva serie
 serie_p.Name = .SpecialCells(xlCellTypeVisible).Cells(1, 1)
 'Se asignan los valores para el eje X a la serie
 serie_p.XValues = .Columns(3).SpecialCells(xlCellTypeVisible)
 'Se asignan los valores para el eje Y a la serie
 serie_p.Values = .Columns(4).SpecialCells(xlCellTypeVisible)
 'Se muestran las etiquetas para la serie
 serie_p.ApplyDataLabels
 End With
 'Se libera la memoria de la serie con la que acabamos de trabajar
 Set serie_p = Nothing
 'Se pasa al siguiente dato único para repetir el bucle y crear una nueva serie con él
 Next p
 'Quita los filtros de la hoja
 .AutoFilter
 'Se activa la actualización de pantalla
 Application.ScreenUpdating = True
 End With
 'Se libera la memoria
 Set poligono = Nothing
 End With
End Sub 

Añade tu respuesta

Haz clic para o