Macro - new sheet per name list and add template in each sheet [Closed]

Registration date
Monday November 7, 2016
Last seen
November 7, 2016
 Richie -
Hi all, I'm a new comer here, but looking forwards to learning and helping others!.

I am trying to create a macro that will:

1. create a new sheet and re-named based off a list I have in sheet 1 (Currently named "CLIENT_ID") and also have the name in cell A1
2. I have a template set up containing formulas in sheet 2 (Currently named "template") and I want this format and formulas to flow into each newly created sheet.

I have been trying but alas been getting no where, I am fairly new to Macros and VBA but am eager to learn.

Thank you

1 reply

Registration date
Thursday July 24, 2014
Last seen
February 16, 2021
Hello Richie,

Have a look at the following link:-

It is a test work book for a Poster I helped a couple of months ago with a very similar query to yours.

In the above test work book, there is a Template sheet and a Summary sheet. The code creates and names new sheets for each ID in Column B of the Summary sheet with each sheet being a copy of the Template. Each client name is also placed in cell A1 of each sheet. Click on the "RUN" button to see it work.

There aren't any formulae in this example but, if there were, they would all be copied over to each new sheet.

The code associated with this example is as follows:-

Option Explicit

Sub CreateSheets()

    Dim wsSumm As Worksheet, wsTmp As Worksheet
    Dim shtNames As Range, N As Range

With ThisWorkbook
    Set wsTmp = .Sheets("Template")
    Set wsSumm = .Sheets("Summary")
    Set shtNames = wsSumm.Range("B2:B" & Rows.Count).SpecialCells(xlConstants)
Application.ScreenUpdating = False

    For Each N In shtNames
        If Not Evaluate("ISREF('" & CStr(N.Text) & "'!A1)") Then
          wsTmp.Copy After:=.Sheets(.Sheets.Count)
            ActiveSheet.Name = CStr(N.Text)
              ActiveSheet.Range("A1").Value = N.Offset(, -1).Value
              End If
         Next N
End With

Application.ScreenUpdating = True

End Sub

Let us know what you think.

Thanks mate, I'll give this a try tomorrow morning

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!