P
PHisaw
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
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