I am trying to make a separate charts for each row on the same sheet.

JonPeltier 

I have been looking for something like this forever, except my scenario is with XY plots and I want to plot in groups of n. For example, my time is in column B and my data goes through column CT. I want to have 3 consecutive columns per graph. Can something similar be done for this or is that too complicated for excel?

Thanks!

JonPeltier 

Hello- I found this code very very helpful so thank you very much for sharing. I have modified it to include two data series. However, I am now struggling with adding a chart title. How can I make the chart title link to a column and change with each new chart generated per row? (As your posted code does but for two data series.) I can post my attempt below -

Sub DuplicateActiveChartOncePerRow()
If ActiveChart Is Nothing Then
MsgBox "Select a chart and try again!", vbExclamation + vbOKOnly
GoTo ExitSub
End If
Dim nCharts As Long
nCharts = ActiveSheet.ChartObjects.Count
Dim OriginalChart As Chart
Set OriginalChart = ActiveChart

' SERIES formula
Dim sFormula As String
Dim sFormula2 As String
sFormula = OriginalChart.SeriesCollection(1).Formula
sFormula2 = OriginalChart.SeriesCollection(2).Formula
' formula arguments only
sFormula = Mid$(Left$(sFormula, Len(sFormula) - 1), InStr(sFormula, "(") + 1)
sFormula2 = Mid$(Left$(sFormula2, Len(sFormula2) - 1), InStr(sFormula2, "(") + 1)
' array of arguments
Dim vFormula As Variant
Dim vFormula2 As Variant
vFormula = Split(sFormula, ",")
vFormula2 = Split(sFormula2, ",")

' series name - first argument
Dim sName As String
sName = vFormula(LBound(vFormula))
Dim rName As Range
On Error Resume Next
Set rName = Range(sName)
On Error GoTo 0
Dim bNameIsRange As Boolean
bNameIsRange = Not rName Is Nothing

Dim sName2 As String
sName2 = vFormula2(LBound(vFormula2))
Dim rName2 As Range
On Error Resume Next
Set rName2 = Range(sName2)
On Error GoTo 0
Dim bNameIsRange2 As Boolean
bNameIsRange2 = Not rName2 Is Nothing

' y values - third argument
Dim sYVals As String
sYVals = vFormula(LBound(vFormula) + 2)
Dim rYVals As Range
On Error Resume Next
Set rYVals = Range(sYVals)
On Error GoTo 0
If rYVals Is Nothing Then
MsgBox "Y Values Are Not in a Range!", vbExclamation + vbOKOnly
GoTo ExitSub
End If

Dim sYVals2 As String
sYVals2 = vFormula2(LBound(vFormula2) + 2)
Dim rYVals2 As Range
On Error Resume Next
Set rYVals2 = Range(sYVals2)
On Error GoTo 0
If rYVals2 Is Nothing Then
MsgBox "Y Values Are Not in a Range!", vbExclamation + vbOKOnly
GoTo ExitSub
End If


Dim iChart As Long
iChart = 1
Do
' loop until we run out of Y values
If WorksheetFunction.Count(rYVals.Offset(iChart)) = 0 Then
MsgBox "Finished!", vbExclamation + vbOKOnly
GoTo ExitSub
End If

' make copy of original chart
OriginalChart.Parent.Copy
Do
' loop to avoid error because sometimes clipboard isn't ready to paste
DoEvents
On Error Resume Next
ActiveSheet.Paste
On Error GoTo 0
If ActiveSheet.ChartObjects.Count >= nCharts + iChart Then Exit Do

Loop
Dim NewChart As Chart
Set NewChart = ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Chart
NewChart.Parent.Left = OriginalChart.Parent.Left
NewChart.Parent.Top = OriginalChart.Parent.Top + iChart * rYVals.Height

' change Y values and name in new chart

With NewChart.SeriesCollection(1)
.Values = rYVals.Offset(iChart)
If bNameIsRange Then
.Name = "=" & rName.Offset(iChart).Address(, , , True) & "!" & Cells(iChart, 3).Address(, , , True)

End If

End With

With NewChart.SeriesCollection(2)
.Values = rYVals2.Offset(iChart)

End With
iChart = iChart + 1
Loop

ExitSub:
End Sub

The chart will not copy on the same sheet.