Lw = Range("b2").End(xlDown).Row
Range("A2:I" & Lw).Select
Set cht1 = ActiveSheet.Shapes.AddChart
cht1.Chart.ChartType = xlLineMarkers
cht1.Chart.Location xlLocationAsNewSheet
ActiveChart.ChartArea.Select
ActiveChart.PlotArea.Select
Dim ValuesArray(), SeriesValues As Variant
Dim Ctr As Integer, TotCtr As Integer
With ActiveChart
For Each x In .SeriesCollection
SeriesValues = x.Values
ReDim Preserve ValuesArray(1 To TotCtr + UBound(SeriesValues))
For Ctr = 1 To UBound(SeriesValues)
ValuesArray(Ctr + TotCtr) = SeriesValues(Ctr)
Next
TotCtr = TotCtr + UBound(SeriesValues)
Next
ActiveChart.FullSeriesCollection(5).Select
ActiveChart.FullSeriesCollection(2).Delete
ActiveChart.FullSeriesCollection(2).Delete
ActiveChart.FullSeriesCollection(2).Delete
ActiveChart.FullSeriesCollection(2).Delete
ActiveChart.FullSeriesCollection(2).Delete
ActiveChart.FullSeriesCollection(2).Delete
With ActiveChart.Axes(xlValue)
.MinimumScale = Application.Min(Range("B2:B" & Lw))
.MaximumScale = Application.Max(Range("B2:B" & Lw))
End With
End With
End Sub