Create a new sheet using the format of an existing sheet using VBA

Question

So I have created a worksheet called template , which is linked with VBA code to do certain operations. I want to be able to add new sheets which have the same format and vba code as the template sheet.

The code I have used is.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Sh.Delete   '-----delete added new page
Application.DisplayAlerts = True
work.Copy After:=ThisWorkbook.Sheets(1)  '-----copy page with formulas, vba code and data
Dim n As Integer
'clear all filled content at new page, so it is "new"=clean
n = ActiveSheet.Range("L8").CurrentRegion.Rows.Count + 7
ActiveSheet.Rows("13:" & n).Delete Shift:=xlUp
ActiveSheet.Range("M8:W12").ClearContents
Application.CutCopyMode = False
ActiveSheet.Range("B8").Select
Selection.ClearContents
ActiveSheet.Range("B8").Activate
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

The code functions, but sometimes I get this error attached below. I am not sure how to resolve this error.

Copy Error

Copy Error 2

Code below, is what I want the sheet to do.

Private Sub Add_Click()
Dim n As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False

n = ActiveSheet.Range("L8").CurrentRegion.Rows.Count + 7   'number of filled rows of records
ActiveSheet.Rows(n - 4 & ":" & n).Copy                     ' adding new record by copy previous one
ActiveSheet.Rows(n + 1 & ":" & n + 1).Select
ActiveSheet.Paste
ActiveSheet.Range("M" & n + 1 & ":W" & n + 5).ClearContents        'clear data in new added(=copied) record
Application.CutCopyMode = False
ActiveSheet.Range("B" & n + 1).Select
Selection.ClearContents

n = ActiveSheet.Range("L8").CurrentRegion.Rows.Count + 7   'number of filled rows
'------total sum
ActiveSheet.Range("U6").Formula = "=SUM(U8:U" & n & ")"
ActiveSheet.Range("V6").Formula = "=SUM(V8:V" & n & ")"
ActiveSheet.Range("W6").Formula = "=SUM(W8:W" & n & ")"
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Activate()
'------------------------on worksheet activate update all dropdownlists
Application.EnableEvents = False
Dim n As Integer
Dim m As Integer

n = temp.Range("B2").CurrentRegion.Rows.Count + 1

'-------update dropdownlist for eg tag
m = ActiveSheet.Range("L8").CurrentRegion.Rows.Count + 7
With ActiveSheet.Range("B8:B" & m).Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='Hidden Page'!$B$3:$B$" & n
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = False
End With

Dim i As Integer

For i = 8 To m - 4 Step 5
'-----------update formula for eg tag record
n = temp.Range("B2").CurrentRegion.Rows.Count + 1
ActiveSheet.Range("C" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",2,0)"
ActiveSheet.Range("D" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",3,0)"
ActiveSheet.Range("E" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",4,0)"
ActiveSheet.Range("F" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",5,0)"
ActiveSheet.Range("G" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",6,0)"
ActiveSheet.Range("H" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",7,0)"
ActiveSheet.Range("I" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",8,0)"
ActiveSheet.Range("J" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",9,0)"
ActiveSheet.Range("K" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",10,0)"

'----update Impeller
Application.Union(ActiveSheet.Range("M" & i), ActiveSheet.Range("O" & i), ActiveSheet.Range("Q" & i), ActiveSheet.Range("S" & i)).Select
n = temp.Range("M5").CurrentRegion.Rows.Count + 4
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='Hidden Page'!$M$6:$M$" & n
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = False
End With

'----update TB
Application.Union(ActiveSheet.Range("M" & i + 1), ActiveSheet.Range("O" & i + 1), ActiveSheet.Range("Q" & i + 1), ActiveSheet.Range("S" & i + 1)).Select
n = temp.Range("Y5").CurrentRegion.Rows.Count + 4
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='Hidden Page'!$Y$6:$Y$" & n
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = False
End With

'----update Volute
Application.Union(ActiveSheet.Range("M" & i + 2), ActiveSheet.Range("O" & i + 2), ActiveSheet.Range("Q" & i + 2), ActiveSheet.Range("S" & i + 2)).Select
n = temp.Range("AK5").CurrentRegion.Rows.Count + 4
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='Hidden Page'!$AK$6:$AK$" & n
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = False
End With

'----update FPLI
Application.Union(ActiveSheet.Range("M" & i + 3), ActiveSheet.Range("O" & i + 3), ActiveSheet.Range("Q" & i + 3), ActiveSheet.Range("S" & i + 3)).Select
n = temp.Range("AW5").CurrentRegion.Rows.Count + 4
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='Hidden Page'!$AW$6:$AW$" & n
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = False
End With

'----update SS
Application.Union(ActiveSheet.Range("M" & i + 4), ActiveSheet.Range("O" & i + 4), ActiveSheet.Range("Q" & i + 4), ActiveSheet.Range("S" & i + 4)).Select
n = temp.Range("BI5").CurrentRegion.Rows.Count + 4
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='Hidden Page'!$BI$6:$BI$" & n
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = False
End With
Next i

Application.EnableEvents = True
ActiveSheet.Range("L6") = ""  '------to call worksheet change event to refresh all data after change on hidden page
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Columns.Count = 1 Then
        If Target.Column >= 12 And Target.Column <= 20 Then  '-----------------when table with details and QTY filled or changed then count price and costs
            Application.EnableEvents = False
            Dim oper As Integer
            Dim cost As Integer
            Dim sale As Integer
            Dim gross As Integer

            Dim q1 As Double
            Dim q2 As Double
            Dim q3 As Double
            Dim q4 As Double

            Dim tot_cost As Integer
            Dim tot_sale As Integer
            Dim tot_gross As Integer
            Dim i As Integer

            '--------ranges of tables of parts Impeller,TB,Volute,FPLI,SS on HiddenPage
            Dim rng2(8 To 12) As String

            rng2(8) = "M6:W" & temp.Range("M5").CurrentRegion.Rows.Count + 4
            rng2(9) = "Y6:AI" & temp.Range("Y5").CurrentRegion.Rows.Count + 4
            rng2(10) = "AK6:AU" & temp.Range("AK5").CurrentRegion.Rows.Count + 4
            rng2(11) = "AW6:BG" & temp.Range("AW5").CurrentRegion.Rows.Count + 4
            rng2(12) = "BI6:BS" & temp.Range("BI5").CurrentRegion.Rows.Count + 4

            Dim j As Integer
            Dim n As Integer
            n = ActiveSheet.Range("L8").CurrentRegion.Rows.Count + 7
            Dim m As Integer
            Dim k As Integer
            k = 0
        For j = 8 To n - 4 Step 5           '-----------loop through all records =every 4 rows

            oper = CInt(ActiveSheet.Range("C" & j).Value)   '------read operator
            '-----based on operator get number of column for the operator
            If oper = 1 Then
                cost = 3
                sale = 6
                gross = 9
            ElseIf oper = 2 Then
                cost = 4
                sale = 7
                gross = 10
            ElseIf oper = 3 Then
                cost = 5
                sale = 8
                gross = 11
            End If

            m = j + 4

            For i = j To m    '---------loop through every row of one record
                '---------------if specified part(=not empty) then find the price for part and save in variable q1,q2,q3,q4
                '-----for cost
                q1 = 0
                q2 = 0
                q3 = 0
                q4 = 0
                If ActiveSheet.Range("M" & i) <> "" Then q1 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("M" & i), temp.Range(rng2(i - k)), cost, 0)
                If ActiveSheet.Range("O" & i) <> "" Then q2 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("O" & i), temp.Range(rng2(i - k)), cost, 0)
                If ActiveSheet.Range("Q" & i) <> "" Then q3 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("Q" & i), temp.Range(rng2(i - k)), cost, 0)
                If ActiveSheet.Range("S" & i) <> "" Then q4 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("S" & i), temp.Range(rng2(i - k)), cost, 0)
                ActiveSheet.Range("U" & i) = q1 * ActiveSheet.Range("N" & i) + q2 * ActiveSheet.Range("P" & i) + q3 * ActiveSheet.Range("R" & i) + q4 * ActiveSheet.Range("T" & i)

                '---for sale
                q1 = 0
                q2 = 0
                q3 = 0
                q4 = 0
                If ActiveSheet.Range("M" & i) <> "" Then q1 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("M" & i), temp.Range(rng2(i - k)), sale, 0)
                If ActiveSheet.Range("O" & i) <> "" Then q2 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("O" & i), temp.Range(rng2(i - k)), sale, 0)
                If ActiveSheet.Range("Q" & i) <> "" Then q3 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("Q" & i), temp.Range(rng2(i - k)), sale, 0)
                If ActiveSheet.Range("S" & i) <> "" Then q4 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("S" & i), temp.Range(rng2(i - k)), sale, 0)
                ActiveSheet.Range("V" & i) = q1 * ActiveSheet.Range("N" & i) + q2 * ActiveSheet.Range("P" & i) + q3 * ActiveSheet.Range("R" & i) + q4 * ActiveSheet.Range("T" & i)

                '----for gross
                q1 = 0
                q2 = 0
                q3 = 0
                q4 = 0
                If ActiveSheet.Range("M" & i) <> "" Then q1 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("M" & i), temp.Range(rng2(i - k)), gross, 0)
                If ActiveSheet.Range("O" & i) <> "" Then q2 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("O" & i), temp.Range(rng2(i - k)), gross, 0)
                If ActiveSheet.Range("Q" & i) <> "" Then q3 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("Q" & i), temp.Range(rng2(i - k)), gross, 0)
                If ActiveSheet.Range("S" & i) <> "" Then q4 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("S" & i), temp.Range(rng2(i - k)), gross, 0)
                ActiveSheet.Range("W" & i) = q1 * ActiveSheet.Range("N" & i) + q2 * ActiveSheet.Range("P" & i) + q3 * ActiveSheet.Range("R" & i) + q4 * ActiveSheet.Range("T" & i)
            Next i
            k = k + 5
        Next j

        n = ActiveSheet.Range("L8").CurrentRegion.Rows.Count + 7
        '----count total sum after QTY or parts were changed
        ActiveSheet.Range("U6").Formula = "=SUM(U8:U" & n & ")"
        ActiveSheet.Range("V6").Formula = "=SUM(V8:V" & n & ")"
        ActiveSheet.Range("W6").Formula = "=SUM(W8:W" & n & ")"

            Application.EnableEvents = True
        End If
    End If
End Sub

The code is not complete plus you should use Option Explicit at the start of each code module. — , Jan 15 '18 at 16:32
What do you mean the code is not complete, should I insert the rest of my code? — Fez, Jan 15 '18 at 16:37
Now you have edited the code to include End Sub. Good! Now add Option Explicit at the top of every code module. — , Jan 15 '18 at 16:39
In your line `work.Copy`, where do you define `work`? If it is an existing sheet in the current workbook, then you need to define , such as `ThisWorkbook.Sheets("Work")` — Darrell H, Jan 15 '18 at 16:40
@Darrel H: Exactly! Leaving out Option Explicit is a lazy programmers signum. — , Jan 15 '18 at 16:44
@Darrell `Work` _could_ be the codename for the sheet in which case it will always be in `ThisWorkbook`. Of course, it could also be a variable name that isn't defined.... — Darren Bartrup-Cook, Jan 15 '18 at 16:45
Darrell, in previous attempts I had it defined like you said. But I would still get the error — Fez, Jan 15 '18 at 16:45
@DarrenBartrup-Cook from the VBE screenshots it's pretty clear that `work` *is* indeed a worksheet's `CodeName`. — Mathieu Guindon, Jan 15 '18 at 16:46
@Mat'sMug Good stuff. Screenshots are blocked here so I can't go on them. :( — Darren Bartrup-Cook, Jan 15 '18 at 16:48
Start with this: [How to avoid Select and Activate](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba?rq=1) - you'll have buggy code for as long as you code against `Selection` and `ActiveCell` and `ActiveSheet`. — Mathieu Guindon, Jan 15 '18 at 16:49
@DarrenBartrup-Cook You are correct, poor example to use Work as the sheet name. Obviously a codename, but no where in the subroutine does he define the worksheet, in which case he needs to either define `work` or use the whole sheet name — Darrell H, Jan 15 '18 at 17:07
@DarrellH actually, no. Using the codename the way OP has it *is* the single most robust and reliable way to refer to a worksheet object that exists at compile-time in `ThisWorkbook`. VBA creates that global-scope object so that it's used, not so that the exact same object reference is dereferenced again from the `ThisWorkbook.Sheets` or `ThisWorkbook.Worksheets` collection. The problem is that I can't seem to relate the screenshot to the code snippet OP posted (which doesn't mention `work` anywhere) — Mathieu Guindon, Jan 15 '18 at 17:10
Also FWIW you should know that the `Sheets` collection can contain `Chart` objects, and many other legacy types of sheets supported by Excel. The `Worksheets` collection, on the other hand, **only** contains `Worksheet` objects. — Mathieu Guindon, Jan 15 '18 at 17:14
Thanks for the info. I did not see the codename in the original screenshot. — Darrell H, Jan 15 '18 at 17:20

score 0 · Accepted Answer · answered Jan 15 '18 at 17:55

Found a solution that works!!

Thank you for all the help.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    ActiveSheet.Delete   '-----delete added new page
    Application.DisplayAlerts = True
    ThisWorkbook.Sheets("Template Sheet").Visible = True
    ThisWorkbook.Sheets("Template Sheet").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)  '-----copy page with formulas, vba code and data
    ThisWorkbook.Sheets("Template Sheet").Visible = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

That's the new code used.

As I said in [this comment](https://stackoverflow.com/questions/48266997/create-a-new-sheet-using-the-format-of-an-existing-sheet-using-vba#comment83518494_48266997), using the worksheet's codename (`work`, I think you have it as) would be much more robust. Now if you (or the user) changes the sheet's name, your code breaks. Also in the same comment thread, the `Sheets` collection can contain many other things than `Worksheet` objects, use the `Worksheets` collection instead. Using the codename would avoid needing to dereference the same object 3 times in a row. — Mathieu Guindon, Jan 15 '18 at 18:20

Create a new sheet using the format of an existing sheet using VBA

1 Answers1