Copy sub from one workbook into another & assign to button

E

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

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
You must log in or register to reply here.

Similar threads

S
  • Question
Excel macros extremely slow
Replies
4
Views
187
Shloime
S
L
  • Solved
Is there a way to generalize my repeated VBA code into one macro that I could apply to ALL buttons?
Replies
5
Views
488
DanteAmor
DanteAmor
willow1985
  • Solved
PrintArea = "TableName" but visible cells only
Replies
2
Views
384
willow1985
willow1985
S
  • Solved
Trying to copy another column from one table to another.
Replies
2
Views
389
Alex Blakenburg
A
J
  • Question
Excel VBA error 400 while link to another sheet
Replies
3
Views
393
rollis13
rollis13

Forum statistics

Threads
1,214,912
Messages
6,122,204
Members
449,072
Latest member
DW Draft

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