Chart Copying Macro in Excel
This Excel 2003 macro code copies charts that exist on individual sheets onto one sheet, sizes them, and previews for printing. It then blanks out the sheet used for consolidation so it is ready for the next time. It works quite well for consolidating multiple charts onto one sheet for printing purposes.
I had a hard time finding any code to accomplish these goals and couldn’t get much help from some of the help sites so I played around with it and wrote my own code.
Sub chght()
' Activate the first sheet that contains a chart
Worksheets("TMIN").Activate
' Select that chart for copy
ActiveSheet.ChartObjects(1).Copy
' Select the destination sheet, location, and paste it
Worksheets("PrtCht").Activate
Range("A1").Select
ActiveSheet.Paste
' Set height of the chart just pasted
ActiveSheet.ChartObjects(1).Height = 148
' the following five routines do the same with a chart on a different sheet
Worksheets("R50").Activate
ActiveSheet.ChartObjects(1).Copy
Worksheets("PrtCht").Activate
Range("A13").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects(2).Height = 148
Worksheets("TMAX").Activate
ActiveSheet.ChartObjects(1).Copy
Worksheets("PrtCht").Activate
Range("A25").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects(3).Height = 148
Worksheets("SP GR").Activate
ActiveSheet.ChartObjects(1).Copy
Worksheets("PrtCht").Activate
Range("A37").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects(4).Height = 148
Worksheets("ML4").Activate
ActiveSheet.ChartObjects(1).Copy
Worksheets("PrtCht").Activate
Range("A49").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects(5).Height = 148
Worksheets("MS").Activate
ActiveSheet.ChartObjects(1).Copy
Worksheets("PrtCht").Activate
Range("A61").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects(6).Height = 148
' this selects a cell so there is no chart selected when going into the print routine
Range("A73").Select
' this code seems to do nothing since the preview shows across multiple sheets the first time
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
' Preview charts on screen
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True, Collate:=True
' Select the destination sheet and delete the charts now that we are through with them
Worksheets("PrtCht").Activate
ActiveSheet.ChartObjects(6).Delete
ActiveSheet.ChartObjects(5).Delete
ActiveSheet.ChartObjects(4).Delete
ActiveSheet.ChartObjects(3).Delete
ActiveSheet.ChartObjects(2).Delete
ActiveSheet.ChartObjects(1).Delete
End Sub