Creating new sheets based off template

[pauldaddyadams]

Hi,

Can anyone help me out with some code which will really save me a lot of time.

I have a summary sheet which lists unique codes in column D. For each code listed in the list I will need a new worksheet created based off the template.
e.g.on the attached the list on the summary sheet is:

• 213000
• 500000
• 662200

So I would need it to create 3 sheets all based off the “template” sheet. The template sheet has the formulas which I need replicating on all of the new sheets created.

On each new sheet if I could have it so the sheet name is named after the account e.g. “213000” and also in B2 of each sheet it also has the account name e.g on sheet 213000 in B2 it has “213000” which means its picked up on the summary sheet.

In my actual data I have lots of account so if there is any way it could look to the list of accounts on the summary sheets and start at cell D5 until the last row rather than fixing the range that will help.

Can anyone help please?

[fredlo2010]

Hello,

Try this code and see if it works. I hope it helps

Sub CreateSheets()
    
    Const lFIRST_ROW_WITH_DATA As Long = 5
    
    Dim shTemplate As Worksheet
    Dim shSummary As Worksheet
    Dim lLastRow As Long
    Dim i As Long
        
    ' Turn extras off to make the code run faster.
    ' You need this there is quite a few array formulas
    Call TurnExtasOff
    
    ' Asign the variables.
    Set shTemplate = ActiveWorkbook.Sheets("Template")
    Set shSummary = ActiveWorkbook.Sheets("Summary")
    lLastRow = shSummary.Cells(shSummary.Rows.Count, "C").End(xlUp).Row
    
    ' Loop through all the rows and grab the data.
    For i = lFIRST_ROW_WITH_DATA To lLastRow
        
        ' Make sure the cell is not empty
        If Not shSummary.Cells(i, 3).Value = vbNullString Then
            ' Copy the template
            shTemplate.Copy After:=Sheets(Sheets.Count)
                        
            ' Change the name and add the value to the cell.
            ActiveSheet.Name = shSummary.Cells(i, 3).Value
            ActiveSheet.Range("B2").Value = shSummary.Cells(i, 3).Value
        End If
    Next i
    
    ' Turn extras back on
    Call TurnExtasOn
    
    ' Clean up
    Set shTemplate = Nothing
    Set shSummary = Nothing
   
    
End Sub

Sub TurnExtasOff()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
End Sub

Sub TurnExtasOn()
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

Thanks

[pauldaddyadams]

This works brilliantly - its so quick! Thank you!

Just a couple of questions..

What does the turn extras on and off do?

If I wanted to change the location of the list on the summary sheet from column C to D would it just be this part I need to change?

lLastRow = shSummary.Cells(shSummary.Rows.Count, "C").End(xlUp).Row

AND this maybe?

ActiveSheet.Range("B2").Value = shSummary.Cells(i, 3).Value

Paul

[fredlo2010]

If I wanted to change the location of the list on the summary sheet from column C to D would it just be this part I need to change?

lLastRow = shSummary.Cells(shSummary.Rows.Count, "C").End(xlUp).Row

AND this maybe?

ActiveSheet.Range("B2").Value = shSummary.Cells(i, 3).Value

Yes you will have to change those that in the First case it says explicitly "C" and in the second one is says its number equivalent 3.

Turn off extras and back on is a helper sub to turn off certain features that you don't need to have in Excel so the code runs faster.
You don't need the screen to display new information until the whole thing is done.
You don't need to calculate anything in the sheets until the whole thing is done...and so on.

Thanks

[pauldaddyadams]

Hi,

I have tested this and I have decided to keep it in that column for ease.

Still curious to know what the "extras" do.

I do have one additional requirement - which is rather than just copy the template to and ensure the template has enough rows (based off the summary sheet) I will pop this up in a new post