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

Report
Posts
1
Registration date
Monday November 7, 2016
Status
Member
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
Richie.

1 reply

Posts
1278
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
February 16, 2021
220
Hello Richie,

Have a look at the following link:-

https://www.dropbox.com/s/vkwf8tr0amfqjm2/ChukieD%28create%20sheets%20from%20template%29.xlsm?dl=0

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
wsSumm.Select
End With

Application.ScreenUpdating = True

End Sub


Let us know what you think.

Cheerio,
vcoolio.
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!