Problem with macro to copy vba to new workbook

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...

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
 

Some videos you may like

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

Watch MrExcel Video

Forum statistics

Threads
1,100,191
Messages
5,473,041
Members
406,843
Latest member
David_Welland

This Week's Hot Topics

Top