Copy sub from one workbook into another & assign to button

excel2007uk

New Member
Joined
Jul 13, 2018
Messages
13
Hi,

I am trying to insert and assign a macro. I have a pretty long bit of code Createandsavejobsht(), it creates a new workbook, copy & pastes from the active workbook into it & saves it as a cell value. I need to edit this to somehow insert and assign a new code to a button. Is this possible?

The first code I would like to run so it inserts the second code into the second/new workbook. The second workbook file name is never the same because the File name = a cell value.

I am not sure even if this is possible, I have tried recording it however I now understand that you are not able to do this. This will be used to create several new workbooks a day by users who are unable to manually copy and paste this, unfortunately.

I would greatly appreciate any help! I am finding it difficult to even get my head around this...


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 = "J P S"
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






Code I would like inserting as follows




VBA Code:
Sub PrintQTYPAGESASCELL()

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 = xlPrintSheetEnd
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .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
    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 = xlPrintSheetEnd
        .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

iNumCopies = Range("O4").Value
ipscopies = Range("O5").Value
ipscopies1 = Range("O6").Value
ipscopies2 = Range("O7").Value
ipscopies3 = Range("O8").Value
ipscopies4 = Range("O9").Value
If iNumCopies > 0 Then
    Sheets("Sheet2").Range("A1:B11").PrintOut Copies:=iNumCopies
End If
If ipscopies > 0 Then
    Sheets("Sheet2").Range("A12:B22").PrintOut Copies:=ipscopies
    End If
If ipscopies1 > 0 Then
    Sheets("Sheet2").Range("A23:B33").PrintOut Copies:=ipscopies1
    
    End If
If ipscopies2 > 0 Then
    Sheets("Sheet2").Range("A34:B44").PrintOut Copies:=ipscopies2
    
    End If
If ipscopies3 > 0 Then
    Sheets("Sheet2").Range("A45:B55").PrintOut Copies:=ipscopies3
    
    End If
If ipscopies4 > 0 Then
    Sheets("Sheet2").Range("A56:B66").PrintOut Copies:=ipscopies4
End If
End Sub
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

Forum statistics

Threads
1,148,145
Messages
5,745,050
Members
423,917
Latest member
Frank1931

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
Top