Home |
Search |
Today's Posts |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Learn Macro & VB Code that usually put in Excel. | Excel Worksheet Functions | |||
Creating charts with VBA code | Charts and Charting in Excel | |||
Copy/Paste Charts; Define Destination of Charts in PowerPoint | Excel Programming | |||
Creating Charts in VBA Code | Excel Programming | |||
Code to copy range vs Copy Entire Worksheet - can't figure it out | Excel Programming |