ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Trying to Learn Code to Copy Charts (https://www.excelbanter.com/excel-programming/435351-trying-learn-code-copy-charts.html)

PHisaw
Trying to Learn Code to Copy Charts
 
Hi,

I have the following code to copy two charts from 'Bookings' sheet and paste
to several other sheets along with other details after the paste on each
sheet. I used the macro recorder to do this as I am so new to vba and took
out what I thought wound not be needed. It works as I want, but as you can
see the code repeats itself for every sheet. There will be 12 in all. Can
someone teach me how to group all the 'paste to' sheets and still have it
update with the correct source data for each chart on each sheet? I have the
two lines of code that are in question flagged below.

Sub ChartCopyCode()
'
Sheets("Bookings").Select
ActiveSheet.Shapes.Range(Array(1, 2)).Select
Selection.Copy

Sheets("Bk01-09").Select
Columns("R:R").ColumnWidth = 20
Columns("Y:Y").ColumnWidth = 20
Range("Q1").Select
ActiveSheet.Paste
ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
ActiveSheet.ChartObjects(2).Activate

***** ActiveChart.SetSourceData
Source:=Sheets("Bk01-09").Range("W2:Y17"), PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Vendor Monthly Bookings "
End With

ActiveSheet.ChartObjects(1).Activate

**** ActiveChart.SetSourceData
Source:=Sheets("Bk01-09").Range("W21:Y31"), PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Slsp Monthly Bookings "
End With

Sheets("Bk02-09").Select
Columns("R:R").ColumnWidth = 20
Columns("Y:Y").ColumnWidth = 20
Range("Q1").Select
ActiveSheet.Paste
ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
ActiveSheet.ChartObjects(2).Activate

***** ActiveChart.SetSourceData Source:=Sheets("Bk02-09").Range("W2:Y17"),
PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Vendor Monthly Bookings "
End With

ActiveSheet.ChartObjects(1).Activate

**** ActiveChart.SetSourceData Source:=Sheets("Bk02-09").Range("W21:Y31"),
PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Slsp Monthly Bookings "
End With
End Sub

Any help with be greatly appreciated.
Thanks in advance.
Phisaw

Per Jessen[_2_]
Trying to Learn Code to Copy Charts
 
Hi

You can create an array variable, with all sheet names to paste to.
Then you can use a loop to paste charts and change the sheet
reference:

Sub ChartCopyCode()
'
Dim ShArr
ShArr = Split("Bk01-09,Bk02-09,Bk03-09", ",")
Sheets("Bookings").Shapes.Range(Array(1, 2)).Copy
For c = LBound(ShArr) To UBound(ShArr)

Sheets(ShArr(c)).Select
Columns("R:R").ColumnWidth = 20
Columns("Y:Y").ColumnWidth = 20
Range("Q1").Select
ActiveSheet.Paste
ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse,
msoScaleFromTopLeft
ActiveSheet.ChartObjects(2).Activate
ActiveChart.SetSourceData Source:=Sheets(ShArr(c)).Range
("W2:Y17"), PlotBy _
:=xlColumns
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Vendor Monthly Bookings "
End With


ActiveSheet.ChartObjects(1).Activate
ActiveChart.SetSourceData Source:=Sheets(ShArr(c)).Range
("W21:Y31"), PlotBy _
:=xlColumns
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Slsp Monthly Bookings "
End With
Next
Application.CutCopyMode = False
End Sub

Regards,
Per

On 23 Okt., 22:13, PHisaw wrote:
Hi,

I have the following code to copy two charts from 'Bookings' sheet and paste
to several other sheets along with other details after the paste on each
sheet. *I used the macro recorder to do this as I am so new to vba and took
out what I thought wound not be needed. *It works as I want, but as you can
see the code repeats itself for every sheet. *There will be 12 in all. *Can
someone teach me how to group all the 'paste to' sheets and still have it
update with the correct source data for each chart on each sheet? *I have the
two lines of code that are in question flagged below. *

Sub ChartCopyCode()
'
* * Sheets("Bookings").Select
* * ActiveSheet.Shapes.Range(Array(1, 2)).Select
* * Selection.Copy

* * Sheets("Bk01-09").Select
* * Columns("R:R").ColumnWidth = 20
* * Columns("Y:Y").ColumnWidth = 20
* * Range("Q1").Select
* * ActiveSheet.Paste
* * ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
* * ActiveSheet.ChartObjects(2).Activate

***** * *ActiveChart.SetSourceData
Source:=Sheets("Bk01-09").Range("W2:Y17"), PlotBy _
* * * * :=xlColumns

* * ActiveChart.SeriesCollection(1).Delete
* * ActiveChart.SeriesCollection(1).DataLabels.Select
* * With Selection.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * ActiveChart.SeriesCollection(1).Select
* * With Selection.Interior
* * * * .ColorIndex = 6
* * * * .Pattern = xlSolid
* * End With
* * With ActiveChart.Axes(xlCategory)
* * * * .ReversePlotOrder = True
* * * * .Crosses = xlMaximum
* * End With
* * With ActiveChart.Axes(xlCategory).TickLabels.Font
* * * * * * .Name = "Arial"
* * * * * * .Size = 7
* * End With
* * With ActiveChart.Axes(xlValue).TickLabels.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * With ActiveChart
* * * * .HasTitle = True
* * * * .ChartTitle.Characters.Text = "Vendor Monthly Bookings "
* * End With

* * ActiveSheet.ChartObjects(1).Activate

**** * *ActiveChart.SetSourceData
Source:=Sheets("Bk01-09").Range("W21:Y31"), PlotBy _
* * * * :=xlColumns

* * ActiveChart.SeriesCollection(1).Delete
* * ActiveChart.SeriesCollection(1).DataLabels.Select
* * With Selection.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * With ActiveChart.Axes(xlCategory)
* * * * .ReversePlotOrder = True
* * * * .Crosses = xlMaximum
* * End With
* * With ActiveChart.Axes(xlCategory).TickLabels.Font
* * * * * * .Name = "Arial"
* * * * * * .Size = 7
* * End With
* * With ActiveChart.Axes(xlValue).TickLabels.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * With ActiveChart
* * * * .HasTitle = True
* * * * .ChartTitle.Characters.Text = "Slsp Monthly Bookings "
* * End With

* * Sheets("Bk02-09").Select
* * Columns("R:R").ColumnWidth = 20
* * Columns("Y:Y").ColumnWidth = 20
* * Range("Q1").Select
* * ActiveSheet.Paste
* * ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
* * ActiveSheet.ChartObjects(2).Activate

***** ActiveChart.SetSourceData Source:=Sheets("Bk02-09").Range("W2:Y17"),
PlotBy _
* * * * :=xlColumns

* *ActiveChart.SeriesCollection(1).Delete
* * ActiveChart.SeriesCollection(1).DataLabels.Select
* * With Selection.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * ActiveChart.SeriesCollection(1).Select
* * With Selection.Interior
* * * * .ColorIndex = 6
* * * * .Pattern = xlSolid
* * End With
* * With ActiveChart.Axes(xlCategory)
* * * * .ReversePlotOrder = True
* * * * .Crosses = xlMaximum
* * End With
* * With ActiveChart.Axes(xlCategory).TickLabels.Font
* * * * * * .Name = "Arial"
* * * * * * .Size = 7
* * End With
* * With ActiveChart.Axes(xlValue).TickLabels.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * With ActiveChart
* * * * .HasTitle = True
* * * * .ChartTitle.Characters.Text = "Vendor Monthly Bookings "
* * End With

* * ActiveSheet.ChartObjects(1).Activate

**** ActiveChart.SetSourceData Source:=Sheets("Bk02-09").Range("W21:Y31"),
PlotBy _
* * * * :=xlColumns

*ActiveChart.SeriesCollection(1).Delete
* * ActiveChart.SeriesCollection(1).DataLabels.Select
* * With Selection.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * With ActiveChart.Axes(xlCategory)
* * * * .ReversePlotOrder = True
* * * * .Crosses = xlMaximum
* * End With
* * With ActiveChart.Axes(xlCategory).TickLabels.Font
* * * * * * .Name = "Arial"
* * * * * * .Size = 7
* * End With
* * With ActiveChart.Axes(xlValue).TickLabels.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * With ActiveChart
* * * * .HasTitle = True
* * * * .ChartTitle.Characters.Text = "Slsp Monthly Bookings "
* * End With
* * End Sub

Any help with be greatly appreciated.
Thanks in advance.
Phisaw

PHisaw
Trying to Learn Code to Copy Charts
 
Per Jessen,

Thank you for replying with explanation and code to group all sheets in an
array. There was one line of code that gave me an "object does not support
this method" error, so I just pasted what I originally had and it worked.
Still much shorter than all the same code for 12 worksheets.

Here's the line that threw the error:

Sheets("Bookings").Shapes.Range(Array(1, 2)).Copy

and I went back with this:

Sheets("Bookings").Select
ActiveSheet.Shapes.Range(Array(1, 2)).Select
Selection.Copy

Thanks again for your help.
Phisaw

"Per Jessen" wrote:

Hi

You can create an array variable, with all sheet names to paste to.
Then you can use a loop to paste charts and change the sheet
reference:

Sub ChartCopyCode()
'
Dim ShArr
ShArr = Split("Bk01-09,Bk02-09,Bk03-09", ",")
Sheets("Bookings").Shapes.Range(Array(1, 2)).Copy
For c = LBound(ShArr) To UBound(ShArr)

Sheets(ShArr(c)).Select
Columns("R:R").ColumnWidth = 20
Columns("Y:Y").ColumnWidth = 20
Range("Q1").Select
ActiveSheet.Paste
ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse,
msoScaleFromTopLeft
ActiveSheet.ChartObjects(2).Activate
ActiveChart.SetSourceData Source:=Sheets(ShArr(c)).Range
("W2:Y17"), PlotBy _
:=xlColumns
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Vendor Monthly Bookings "
End With


ActiveSheet.ChartObjects(1).Activate
ActiveChart.SetSourceData Source:=Sheets(ShArr(c)).Range
("W21:Y31"), PlotBy _
:=xlColumns
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Slsp Monthly Bookings "
End With
Next
Application.CutCopyMode = False
End Sub

Regards,
Per

On 23 Okt., 22:13, PHisaw wrote:
Hi,

I have the following code to copy two charts from 'Bookings' sheet and paste
to several other sheets along with other details after the paste on each
sheet. I used the macro recorder to do this as I am so new to vba and took
out what I thought wound not be needed. It works as I want, but as you can
see the code repeats itself for every sheet. There will be 12 in all. Can
someone teach me how to group all the 'paste to' sheets and still have it
update with the correct source data for each chart on each sheet? I have the
two lines of code that are in question flagged below.

Sub ChartCopyCode()
'
Sheets("Bookings").Select
ActiveSheet.Shapes.Range(Array(1, 2)).Select
Selection.Copy

Sheets("Bk01-09").Select
Columns("R:R").ColumnWidth = 20
Columns("Y:Y").ColumnWidth = 20
Range("Q1").Select
ActiveSheet.Paste
ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
ActiveSheet.ChartObjects(2).Activate

***** ActiveChart.SetSourceData
Source:=Sheets("Bk01-09").Range("W2:Y17"), PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Vendor Monthly Bookings "
End With

ActiveSheet.ChartObjects(1).Activate

**** ActiveChart.SetSourceData
Source:=Sheets("Bk01-09").Range("W21:Y31"), PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Slsp Monthly Bookings "
End With

Sheets("Bk02-09").Select
Columns("R:R").ColumnWidth = 20
Columns("Y:Y").ColumnWidth = 20
Range("Q1").Select
ActiveSheet.Paste
ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
ActiveSheet.ChartObjects(2).Activate

***** ActiveChart.SetSourceData Source:=Sheets("Bk02-09").Range("W2:Y17"),
PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Vendor Monthly Bookings "
End With

ActiveSheet.ChartObjects(1).Activate

**** ActiveChart.SetSourceData Source:=Sheets("Bk02-09").Range("W21:Y31"),
PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Slsp Monthly Bookings "
End With
End Sub

Any help with be greatly appreciated.
Thanks in advance.
Phisaw

.


All times are GMT +1. The time now is 03:00 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com