Excel Visual Basic #5: Duplicating Sheets

By Joshua Render on August 29, 2018 • ( Leave a comment )

In this tutorial, I am going to show you how to duplicate sheets from a template sheet. This is aimed at someone who knows the basics of VBA. I assume you know how to do a lot of things already and I don’t explain a lot of the small details. If you are unsure how to do some of the things not detailed here, please look at the beginner lessons on the Excel VBA Tutorials page.

What are we building?

Requirements

A way to tell the application how many sheets
- Allowing for multiple duplications
- Controlled to limit the maximum amount and text entry
A template sheet for copying
A standardized naming structure for the new sheets
- Ensure that a sheet doesn’t already exist before creating it

1. Preparing your workbook

I have provided a VBA free copy of the workbook I am using, Sample Workbook File.

You can either use that VBA free copy or create your own. This tutorial requires two Excel Sheets. The first sheet should be renamed to “Copy Sheets” and the second one should be renamed to “Template.”

The “Copy Sheets” sheet should have a text box and a single button. In the properties, I have named the text box “CopyAmount” and the button is named “MakeCopy.” An image of my “Copy Sheets” sheet is below.

The goal of this tutorial is to show you how to duplicate and add sheets using Excel VBA, so you can put whatever you want on the “Template” sheet. I made a sample chart using freeze panes on the first column and first row. We will copy all formatting over, including the freeze panes. My “Template” sheet looks like the below image.

2. Create a function to check for the existence of a sheet

This one is really simple, we just want a quick boolean (true or false) value back telling us if a sheet exists or not. This function will do that:

Private Function DoesSheetExist(sheetName As String) As Boolean
     DoesSheetExist = Evaluate("ISREF('" & sheetName & "'!A1)")
 End Function

All it basically does is look for the existence of a sheet name. Add that code to the “Sheet 1” developers panel.

3. Build the copying code

We need to copy over everything contained in the template. Our template has colored cells, text, fonts and font color, freeze panes, and custom cell and row widths. We are going to create one subroutine to handle it all, but it will have a couple of different parts.

a. Declare a new subroutine with two parameters, one for the new sheet name and one for the sheet template name.

Private Sub createSheets(sheetAppend As String, sheetTemplate As String)

b. Declare two variables, one for the new sheet and one for the existence of the new sheet.

Dim sheet As Excel.Worksheet
 Dim sExists As Boolean

c. Call the function you created in step 2 above and check to see if the new sheet already exists.

 sExists = DoesSheetExist(sheetAppend)

d. If it does not exist, create it, name it, and copy over the cell contents.

If Not sExists Then
           Set sheet = ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
           sheet.Name = sheetAppend
           Sheets(sheetTemplate).Range("A1:H12").Copy Destination:=Sheets(sheetAppend).Range("A1:H12")

In the code above, we are telling the application to add a worksheet in after the current last worksheet, we are assigning it a name, and just doing a blanket copy of the cell contents. No formatting is being copied currently.

If you don’t want to declare your cell ranges, the last line above could be written like this:

Sheets(sheetTemplate).Cells.Copy Destination:=Sheets(sheetAppend).Cells

e. Check again to make sure the sheet exists.

This time, we want the sheet to exist. Keep the following code all within the above “If Not sExists Then" code block.

sExists = DoesSheetExist(sheetAppend)

f. After making sure it exists, create two worksheet objects and assign one to the template sheet and one to the newly created sheet.

If sExists Then
             Dim source As Worksheet
             Dim target As Worksheet
             Set source = ActiveWorkbook.Worksheets(sheetTemplate)
             Set target = ActiveWorkbook.Worksheets(sheetAppend)

g. Now we have to use those objects to copy over the formatting.

source.Cells.Copy
 target.Cells.PasteSpecial Paste:=xlPasteColumnWidths
 target.Cells.PasteSpecial Paste:=xlPasteFormats
 Application.CutCopyMode = False

h. And now we want to check if the template has freeze panes, and if so, add them (we can’t copy them, so we add them).

ActiveWorkbook.Worksheets(sheetAppend).Activate
 If ActiveWindow.FreezePanes Then ActiveWindow.FreezePanes = False
 ActiveWindow.SplitColumn = 1
 ActiveWindow.SplitRow = 1
 ActiveWindow.FreezePanes = True

i. All we need to do now is close out the if/else decision structures and the subroutine

        Else
             MsgBox "Sheet creation failed"
         End If
     End If
 End Sub

Your total subroutine should look like the below (minus the color coding):

Private Sub createSheets(sheetAppend As String, sheetTemplate As String)
     Dim sheet As Excel.Worksheet
     Dim sExists As Boolean
    
     sExists = DoesSheetExist(sheetAppend)
        
     If Not sExists Then
         Set sheet = ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
         sheet.Name = sheetAppend
         Sheets(sheetTemplate).Range("A1:H12").Copy Destination:=Sheets(sheetAppend).Range("A1:H12")
          
         sExists = DoesSheetExist(sheetAppend)
    
         If sExists Then
             Dim source As Worksheet
             Dim target As Worksheet
             Set source = ActiveWorkbook.Worksheets(sheetTemplate)
             Set target = ActiveWorkbook.Worksheets(sheetAppend)
            
             source.Cells.Copy
             target.Cells.PasteSpecial Paste:=xlPasteColumnWidths
             target.Cells.PasteSpecial Paste:=xlPasteFormats
             Application.CutCopyMode = False
        
          
             ActiveWorkbook.Worksheets(sheetAppend).Activate
             If ActiveWindow.FreezePanes Then ActiveWindow.FreezePanes = False
             ActiveWindow.SplitColumn = 1
             ActiveWindow.SplitRow = 1
             ActiveWindow.FreezePanes = True
         Else
             MsgBox "Sheet creation failed"
         End If
     End If
 End Sub

4. Programming the CopyAmount text box

You should just double-click the text box on the “Copy Sheets” sheet and have it auto create the CopyAmount_Change subroutine for you.

Private Sub CopyAmount_Change()
     If IsNumeric(CopyAmount.Value) Then
         If CopyAmount.Value > 10 Then
             CopyAmount.Value = 10
         End If
     Else
         CopyAmount.Value = ""
     End If
 End Sub

The above code checks to make sure that the values entered in the text box are numeric using IsNumeric(CopyAmount.Value). If they are not numeric, it sets the value back to a blank string.

Within the IsNumeric if/then structure is another check. This is a maximum value. You can set it to whatever you want, or have no limit – but if too many sheets are created you run the risk of having Excel crash closed (it probably could handle a hundred sheets fine, but after that, all bets are off).

5. Programming the button

Now you need all the code to execute at the push of a button. As with the text box, you can have it auto create the subroutine and then just add code into it.

Private Sub MakeCopy_Click()
     Dim CopyAmountVal As String
     Dim CopyCounterVal As Integer
     CopyAmountVal = CopyAmount.Value
     CopyCounterVal = 0
    
     If CopyAmountVal = "" Then
         MsgBox "Please enter a numerical value"
     Else
         While Not CopyAmountVal = CInt(CopyCounterVal)
             CopyCounterVal = CopyCounterVal + 1
             Call createSheets("Template Copy " & CStr(CopyCounterVal), "Template")
         Wend
     End If
 End Sub

This code is looking to see if the text box contains a value since we already check to make sure it has a number. For added safety, you could put in an isNumeric check here as well. But if it passes the checks, it then enters a loop, using an iterated value to check when it should exit the loop and append a numeral to the name of the new sheet. The “createSheets” subroutine from step 3 is called here over and over again until it makes all the sheets it needs.

6. Homework

A. Create a way to delete sheets using a button.

Private Sub deleteSheets(sheetName As String)
      Dim sExists As Boolean
     sExists = DoesSheetExist(sheetName)
     If sExists Then
         'Application.DisplayAlerts = False
          Worksheets(sheetName).Delete
         'Application.DisplayAlerts = True
     End If
 End Sub

The above subroutine deletes a sheet as long as it is passed a sheet name. The commented out green text will suppress the alerts that pop up when you delete a sheet.