Problem with macro to copy vba to new workbook

E

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
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
You must log in or register to reply here.

Similar threads

P
  • Question Question
Help with Vba Code
Replies
3
Views
478
Coyotex3
C
C
  • Solved
Automation error The Object invoked has disconnected from its clients.
Replies
7
Views
1K
cstuder
C
R
  • Question Question
[VBA] - Need to Hide one column and need sum of columns
Replies
0
Views
197
rsolanki
R
An Quala
  • Question Question
Should I name it Active.Sheet or sheet name?
Replies
8
Views
921
MARK858
MARK858
M
  • Question Question
Saveas newwb, close new wb, delete old wb
Replies
8
Views
539
eiloken
E

Forum statistics

Threads
1,224,817
Messages
6,181,147
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top