COPYING A CHART!

J

jay dean

..Need help with 2 macros:

I have a chart occupying range("A1:AG30"). I need a macro that will
paste a copy of this first chart after every two rows till 50 copies of
the chart are made down the sheet.

Also, I need a blueprint for a second macro showing how to loop through
the charts and modify each chart's title and data source,etc if
possible.

Any help would be appreciated.

Thanks
Jay
 
G

Guest

Hi Jay:

Have a lookat the following sub.

It assumes you have one chart on the sheet and it sets the data area and
title
You need to modify the data areas and may be tweak some options.

Sub MakeCharts()
Const cszDataCSrt As String = "A" ' start column for data
Const cszDataCEnd As String = "B" ' end column for data
Const clNrDataRows As Long = 3 ' number of rows of data
Const clTitleOffsetRow As Long = -1 ' offset for title
Const clNrCharts As Long = 50 ' number of charts to make (ie less 1)
Const clRowOffset As Long = 10 ' increment for each chart
Dim iChart As Long ' chart count
Dim lRow As Long ' row pointer
Dim szData As String ' range for data
Dim szTitle As String ' range for title

lRow = 1 ' first row with the real chart in

For iChart = 2 To clNrCharts
' Copy chart
ActiveSheet.ChartObjects(1).Chart.ChartArea.Copy
' Set row and area to paste
lRow = lRow + clRowOffset
ActiveSheet.Range("D" & lRow).Select
ActiveSheet.Paste
' update the chart
With ActiveChart
' modify as needed
' data area
' source data modify
szData = cszDataCSrt & lRow & ":" & cszDataCEnd & lRow & _
"," & cszDataCSrt & lRow + 1 & ":" & cszDataCEnd & _
lRow + clNrDataRows
szTitle = cszDataCSrt & lRow + clTitleOffsetRow
.SetSourceData Source:=ActiveSheet.Range( _
szData), PlotBy:=xlColumns
' chart title
.HasTitle = True
.ChartTitle.Text = ActiveSheet.Range(szTitle)
End With
Next iChart
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top