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
|