This macro works like I want it to, however, it runs extrememly slow. Is there a better way to code this so it speeds up? The macro exports a client file containing graphs and other information. There are more pages than this, but coding just repeats. Any help would be appreciated.
VBA Code:
Sub ClientCopy()
' Client - graphs and reports
Application.ScreenUpdating = False
Application.CalculateFull
ThisWorkbook.Worksheets("Co Cover").Cells.Copy
Workbooks.Add
wbname = ActiveWorkbook.Name
ActiveSheet.Name = "Cover"
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("a1").Select
With ActiveSheet.PageSetup
.PrintArea = "$A$1:$N$47"
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0#)
.FooterMargin = Application.InchesToPoints(0#)
.Zoom = False
.CenterHorizontally = True
.CenterVertically = True
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ThisWorkbook.Worksheets("Co Letter").Cells.Copy
Workbooks(wbname).Sheets.Add after:=ActiveSheet
ActiveSheet.Name = "Letter"
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("a1").Select
With ActiveSheet.PageSetup
.PrintArea = "$A$1:$N$46"
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0#)
.FooterMargin = Application.InchesToPoints(0#)
.Zoom = False
.CenterHorizontally = True
.CenterVertically = True
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ThisWorkbook.Worksheets("Template").Cells.Copy
Workbooks(wbname).Sheets.Add after:=ActiveSheet
ActiveSheet.Name = "Co RRQ "
Cells.Select
ActiveSheet.Paste
With ActiveSheet.PageSetup
.PrintArea = "$A$1:$N$46"
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0#)
.FooterMargin = Application.InchesToPoints(0#)
.Zoom = False
.CenterHorizontally = True
.CenterVertically = True
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ThisWorkbook.Worksheets("Co RRQ").ChartObjects("Chart 1").Copy
Workbooks(wbname).Activate
Range("C6").Select
ActiveSheet.Pictures.Paste
Range("a1").Select
ThisWorkbook.Worksheets("Co RRQ").Range("C5:L5").Copy ' co name
Workbooks(wbname).Worksheets("RRQ ").Range("C5:L5").PasteSpecial (xlPasteValues)
ThisWorkbook.Worksheets("Co RRQ").Range("C31:L42").Copy ' graph write up
Workbooks(wbname).Worksheets("RRQ ").Range("C31:L42").PasteSpecial (xlPasteValues)
ThisWorkbook.Worksheets("Co RRQ").Range("C44:L44").Copy ' pg number
Workbooks(wbname).Worksheets("RRQ ").Range("C44:L44").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Last edited by a moderator: