excel2007uk
New Member
- Joined
- Jul 13, 2018
- Messages
- 13
Hi, I don't know if anyone can help, I am not that experienced when it comes to VBA, I have found the following code online & modified it slightly to fit my needs.
I am trying to copy a module called PrintQTYPAGESASCELL()
If I am honest, I don't understand what each line is doing, I think I am correct in editing Const on the second line to my module name. I don't run into any errors, it just dosen't copy the code, any ideas why this would be?
I found this code here: Need a Macro to copy a VBA Module to a New Workbook...
I would like to incorporate it into the following code eventually
I am trying to copy a module called PrintQTYPAGESASCELL()
If I am honest, I don't understand what each line is doing, I think I am correct in editing Const on the second line to my module name. I don't run into any errors, it just dosen't copy the code, any ideas why this would be?
I found this code here: Need a Macro to copy a VBA Module to a New Workbook...
VBA Code:
Sub TransferModule()
Const PrintQTYPAGESASCELL As String = "Misc" ' Name of the module to transfer
Const TEMPFILE As String = "c:\Modul.bas" ' temp textfile
Dim WBK As Workbook
On Error Resume Next
'**Create new workbook
Set WBK = Workbooks.Add
'** export the module to a textfile
ThisWorkbook.VBProject.VBComponents(PrintQTYPAGESASCELL).Export TEMPFILE
'import the module to the new workbook
WBK.VBProject.VBComponents.Import TEMPFILE
'kill the textfile
Kill TEMPFILE
End Sub
I would like to incorporate it into the following code eventually
VBA Code:
Sub Createandsavejobsht()
Dim Rng As Range
Dim Rng2 As Range
Dim Path As String
Dim filename As String
Dim username As String
username = Environ$("username")
Set Rng = Range("Y1:AU100")
Set Rng2 = Range("C52:G52")
Path = "C:\Users\chris\OneDrive\Desktop\New Cost Sheets"
filename = Range("Y2")
Application.Workbooks.Add
Rng.Copy
ActiveSheet.Range("A1").PasteSpecial xlPasteAll
ActiveSheet.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
ActiveSheet.Range("A1").PasteSpecial xlPasteColumnWidths
Range("A1:N42").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$N$42"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$A$1:$N$42"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.TEXT = ""
.EvenPage.CenterHeader.TEXT = ""
.EvenPage.RightHeader.TEXT = ""
.EvenPage.LeftFooter.TEXT = ""
.EvenPage.CenterFooter.TEXT = ""
.EvenPage.RightFooter.TEXT = ""
.FirstPage.LeftHeader.TEXT = ""
.FirstPage.CenterHeader.TEXT = ""
.FirstPage.RightHeader.TEXT = ""
.FirstPage.LeftFooter.TEXT = ""
.FirstPage.CenterFooter.TEXT = ""
.FirstPage.RightFooter.TEXT = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$A$1:$N$42"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.TEXT = ""
.EvenPage.CenterHeader.TEXT = ""
.EvenPage.RightHeader.TEXT = ""
.EvenPage.LeftFooter.TEXT = ""
.EvenPage.CenterFooter.TEXT = ""
.EvenPage.RightFooter.TEXT = ""
.FirstPage.LeftHeader.TEXT = ""
.FirstPage.CenterHeader.TEXT = ""
.FirstPage.RightHeader.TEXT = ""
.FirstPage.LeftFooter.TEXT = ""
.FirstPage.CenterFooter.TEXT = ""
.FirstPage.RightFooter.TEXT = ""
End With
Application.PrintCommunication = True
Rng2.Copy
ActiveSheet.Range("C52:G52").PasteSpecial xlPasteFormulas
Sheets.Add After:=ActiveSheet
With Selection.Font
.Name = "Calibri"
.Size = 72
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
ActiveCell.FormulaR1C1 = "JB "
Range("A5").Select
ActiveCell.FormulaR1C1 = "CUSTOMER:"
Range("A7").Select
ActiveCell.FormulaR1C1 = "CUSTOMER REF:"
Range("A9").Select
ActiveCell.FormulaR1C1 = "SIZE:"
Range("A11").Select
ActiveCell.FormulaR1C1 = "PALLET QUANTITY:"
Range("A5:A11").Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Calibri"
.Size = 36
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
ActiveWindow.Zoom = 90
ActiveWindow.Zoom = 80
ActiveWindow.Zoom = 70
Columns("A:A").ColumnWidth = 54.89
Columns("B:B").ColumnWidth = 116.33
Range("B5").Select
ActiveCell.FormulaR1C1 = "=Sheet1!RC"
Range("B7").Select
ActiveCell.FormulaR1C1 = "=Sheet1!RC"
Range("B9").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[2]C"
Range("B11").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-7]C[14]"
Range("B5:B11").Select
With Selection.Font
.Name = "Calibri"
.Size = 36
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1:B11").Select
Range("B1").Activate
Selection.Copy
Range("A12").Select
ActiveSheet.Paste
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 9
Range("A23").Select
ActiveSheet.Paste
Range("A34").Select
ActiveSheet.Paste
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 28
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 31
Range("A45").Select
ActiveSheet.Paste
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 41
ActiveWindow.ScrollRow = 42
Range("A56").Select
ActiveSheet.Paste
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 41
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 32
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 1
ActiveWindow.Zoom = 60
ActiveWindow.Zoom = 50
ActiveWindow.Zoom = 40
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 4
Range("B16").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=Sheet1!R[-11]C"
Range("B18").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-11]C"
Range("B20").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-9]C"
Range("B22").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-17]C[14]"
Range("B27").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-22]C"
Range("B29").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-22]C"
Range("B31").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-20]C"
Range("B33").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-27]C[14]"
Range("B38").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-33]C"
Range("B40").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-33]C"
Range("B42").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-31]C"
Range("B44").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-37]C[14]"
Range("B49").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-44]C"
Range("B51").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-44]C"
Range("B53").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-42]C"
Range("B55").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-47]C[14]"
Range("B60").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-55]C"
Range("B62").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-55]C"
Range("B64").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-53]C"
Range("B66").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-57]C[14]"
Range("B68").Select
ActiveWorkbook.SaveAs filename:=Path & "\" & filename & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub