VBA Code to Create A New Sheet from a Template and Rename it from a List

G

grace12

New Member
Joined
Sep 22, 2012
Messages
4
Hi All,

I have a workbook that I am using to track all my new clients.

I have a worksheet called 'MasterData' that lists all my client names in Column B(Cell B3 and beyond) and this is formatted as a table. Column B currently has 52 entries and I keep adding to the list. I also have a worksheet called 'Template' having some basic formulas, which is to be copied. There are existing sheets for 35 client names (1 worksheet per client) in no particular order.

I want to run a macro 'CreateSheet' that copies the worksheet 'Template' along with its formulas to a new worksheet and rename it to a missing client name. At the same time, if a worksheet with the client name exists, I want excel to ignore it (keep the existing data intact) and move to the next. If worksheets exists for all clients, then I want to get a message 'All Client Sheets Updated'.

Please also note my Worksheets are not in order. For example MasterData is Sheet 4 and Template is sheet 42.

Please help.
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Sort by date Sort by votes
Try this:
Code: 
Option Explicit

Sub SheetsFromTemplate()
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shNAMES As Range, Nm As Range

With ThisWorkbook                                               'keep focus in this workbook
    Set wsTEMP = .Sheets("Template")                            'sheet to be copied
    wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)              'check if it's hidden or not
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      'make it visible
    
    Set wsMASTER = .Sheets("Master")                            'sheet with names
                                                                'range to find names to be checked
    Set shNAMES = wsMASTER.Range("B3:B" & Rows.Count).SpecialCells(xlConstants)     'or xlFormulas
    
    Application.ScreenUpdating = False                              'speed up macro
    For Each Nm In shNAMES                                          'check one name at a time
        If Not Evaluate("ISREF('" & CStr(Nm.Text) & "'!A1)") Then   'if sheet does not exist...
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)               '...create it from template
            ActiveSheet.Name = CStr(Nm.Text)                        '...rename it
        End If
    Next Nm
    
    wsMASTER.Activate                                           'return to the master sheet
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden       'hide the template if necessary
    Application.ScreenUpdating = True                           'update screen one time at the end
End With

MsgBox "All sheets created"
End Sub
 
Upvote 0
jbeaucaire said:
Try this:
Code: 
Option Explicit

Sub SheetsFromTemplate()
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shNAMES As Range, Nm As Range

With ThisWorkbook                                               'keep focus in this workbook
    Set wsTEMP = .Sheets("Template")                            'sheet to be copied
    wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)              'check if it's hidden or not
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      'make it visible
    
    Set wsMASTER = .Sheets("Master")                            'sheet with names
                                                                'range to find names to be checked
    Set shNAMES = wsMASTER.Range("B3:B" & Rows.Count).SpecialCells(xlConstants)     'or xlFormulas
    
    Application.ScreenUpdating = False                              'speed up macro
    For Each Nm In shNAMES                                          'check one name at a time
        If Not Evaluate("ISREF('" & CStr(Nm.Text) & "'!A1)") Then   'if sheet does not exist...
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)               '...create it from template
            ActiveSheet.Name = CStr(Nm.Text)                        '...rename it
        End If
    Next Nm
    
    wsMASTER.Activate                                           'return to the master sheet
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden       'hide the template if necessary
    Application.ScreenUpdating = True                           'update screen one time at the end
End With

MsgBox "All sheets created"
End Sub
Click to expand...

Thank you @jbeaucaire .. Works perfectly. Cant thank you enough!
 
Upvote 0
Here's another update used to insure the sheetnames are the correct length and do not include any illegal characters:
Code: 
Option Explicit

Sub SheetsFromTemplate()
'Jerry Beaucaire - 10/22/2014
'Create copies of a template sheet using text on a master sheet in a specific column
'Sheetname strings are corrected using the UDF below
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shNAMES As Range, Nm As Range, NmSTR As String

With ThisWorkbook                                               'keep focus in this workbook
    Set wsTEMP = .Sheets("Template")                            'sheet to be copied
    wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)              'check if it's hidden or not
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      'make it visible
    
    Set wsMASTER = .Sheets("Master")                            'sheet with names
                                                                'range to find names to be checked
    Set shNAMES = wsMASTER.Range("B3:B" & Rows.Count).SpecialCells(xlConstants)     'or xlFormulas
    
    Application.ScreenUpdating = False                          'speed up macro
    For Each Nm In shNAMES                                      'check one name at a time
        NmSTR = FixStringForSheetName(CStr(Nm.Text))            'use UDF to create a legal sheetname
        If Not Evaluate("ISREF('" & NmSTR & "'!A1)") Then       'if sheet does not exist...
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)           '...create it from template
            ActiveSheet.Name = NmSTR                            '...rename it
        End If
    Next Nm
    
    wsMASTER.Activate                                           'return to the master sheet
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden       'hide the template if necessary
    Application.ScreenUpdating = True                           'update screen one time at the end
End With

MsgBox "All sheets created"
End Sub


Function FixStringForSheetName(shSTR As String) As String

'replace each forbidden character with something acceptable
    shSTR = Replace(shSTR, ":", "")
    shSTR = Replace(shSTR, "?", "")
    shSTR = Replace(shSTR, "*", "")
    shSTR = Replace(shSTR, "/", "-")
    shSTR = Replace(shSTR, "\", "-")
    shSTR = Replace(shSTR, "[", "(")
    shSTR = Replace(shSTR, "]", ")")

'sheet names can only be 31 characters
    FixStringForSheetName = Trim(Left(shSTR, 31))

End Function
 
Upvote 0
jbeaucaire said:
Here's another update used to insure the sheetnames are the correct length and do not include any illegal characters:
Code: 
Option Explicit  Sub SheetsFromTemplate() 'Jerry Beaucaire - 10/22/2014 'Create copies of a template sheet using text on a master sheet in a specific column 'Sheetname strings are corrected using the UDF below Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean Dim shNAMES As Range, Nm As Range, NmSTR As String  With ThisWorkbook                                               'keep focus in this workbook     Set wsTEMP = .Sheets("Template")                            'sheet to be copied     wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)              'check if it's hidden or not     If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      'make it visible          Set wsMASTER = .Sheets("Master")                            'sheet with names                                                                 'range to find names to be checked     Set shNAMES = wsMASTER.Range("B3:B" & Rows.Count).SpecialCells(xlConstants)     'or xlFormulas          Application.ScreenUpdating = False                          'speed up macro     For Each Nm In shNAMES                                      'check one name at a time         NmSTR = FixStringForSheetName(CStr(Nm.Text))            'use UDF to create a legal sheetname         If Not Evaluate("ISREF('" & NmSTR & "'!A1)") Then       'if sheet does not exist...             wsTEMP.Copy After:=.Sheets(.Sheets.Count)           '...create it from template             ActiveSheet.Name = NmSTR                            '...rename it         End If     Next Nm          wsMASTER.Activate                                           'return to the master sheet     If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden       'hide the template if necessary     Application.ScreenUpdating = True                           'update screen one time at the end End With  MsgBox "All sheets created" End Sub   Function FixStringForSheetName(shSTR As String) As String  'replace each forbidden character with something acceptable     shSTR = Replace(shSTR, ":", "")     shSTR = Replace(shSTR, "?", "")     shSTR = Replace(shSTR, "*", "")     shSTR = Replace(shSTR, "/", "-")     shSTR = Replace(shSTR, "\", "-")     shSTR = Replace(shSTR, "[", "(")     shSTR = Replace(shSTR, "]", ")")  'sheet names can only be 31 characters     FixStringForSheetName = Trim(Left(shSTR, 31))  End Function
Click to expand...
@jbeaucaire can you update your code to copy the row from the master and paste it into the next blank line below C20 in each sheet?
 
Upvote 0
Maybe this addition:
Code: 
        If Not Evaluate("ISREF('" & NmSTR & "'!A1)") Then       'if sheet does not exist...
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)           '...create it from template
            ActiveSheet.Name = NmSTR                            '...rename it
[COLOR="#FF0000"]            Nm.EntireRow.Copy Range("C" & Rows.Count).End(xlUp).Offset(, -2)[/COLOR]
        End If
 
Upvote 0
Close. but the data pasted into A not C. also I need it to paste the data from each row even if the sheet already exists. I really appreciate your help I have no VBA knowledge and VERY little coding ability what so ever. here are my sheets: "input" is the master in your code I also need to get the start and end date into the sheets. Excel 2012
ABCD
start
end
param1param2param3
unitsunitsunits
subject1ABC
subject2EFG
subject3IJK
subject4MNO
subject5QRS
<colgroup><col width="25px" style="background-color: #DAE7F5" /><col /><col /><col /><col /></colgroup><thead> </thead><tbody> [TD="align: center"]1[/TD] [TD="align: right"]yymmdd[/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: center"]2[/TD] [TD="align: right"]YYMMDD[/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: center"]3[/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: center"]4[/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: center"]5[/TD] [TD="align: right"][/TD] [TD="align: center"]6[/TD] [TD="align: right"][/TD] [TD="align: center"]7[/TD] [TD="align: center"]8[/TD] [TD="align: center"]9[/TD] [TD="align: center"]10[/TD] [TD="align: center"]11[/TD] </tbody>
Input​
Excel 2012
ABCDEF
DATA
start dateend date
<colgroup><col width="25px" style="background-color: #DAE7F5" /><col /><col /><col /><col /><col /><col /></colgroup><thead> </thead><tbody> [TD="align: center"]17[/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: center"]18[/TD] [TD="align: right"][/TD] [TD="align: center"][/TD] [TD="align: center"]param1[/TD] [TD="align: center"]param2[/TD] [TD="align: center"]param3[/TD] [TD="align: center"]19[/TD] [TD="align: center"]subject[/TD] [TD="align: center"]units[/TD] [TD="align: center"]units[/TD] [TD="align: center"]units[/TD] [TD="align: center"]20[/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: center"]21[/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] </tbody>
Template​
This is the result im looking for: Excel 2012
ABCDEF
DATA
start dateend date
yymmddYYMMDDsubject1ABC
<colgroup><col width="25px" style="background-color: #DAE7F5" /><col /><col /><col /><col /><col /><col /></colgroup><thead> </thead><tbody> [TD="align: center"]17[/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: center"]18[/TD] [TD="align: right"][/TD] [TD="align: center"][/TD] [TD="align: center"]param1[/TD] [TD="align: center"]param2[/TD] [TD="align: center"]param3[/TD] [TD="align: center"]19[/TD] [TD="align: center"]subject[/TD] [TD="align: center"]units[/TD] [TD="align: center"]units[/TD] [TD="align: center"]units[/TD] [TD="align: center"]20[/TD] [TD="align: center"]21[/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] [TD="align: right"][/TD] </tbody>
subject1​
 
Upvote 0
Is this better:

Rich (BB code): 
        If Not Evaluate("ISREF('" & NmSTR & "'!A1)") Then       'if sheet does not exist...
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)           '...create it from template
            ActiveSheet.Name = NmSTR                            '...rename it
        End If
        Nm.Resize(, 500).Copy Range("C" & Rows.Count).End(xlUp).Offset(1)
    Next Num
 
Upvote 0
That line works great, But I still can not get it to work how I want. let me explain some more.

I need to be able to run the code again with new data in the info sheet. However the next set of data might have new subjectX and all the old subjects. but the data will be all different. So I need to pull the data to each sheet even if its not new. Your last code works great but only if it creates a new sheet. I also need to copy the dates from B1:B2 and paste them as shown above in my example tables in each sheet.

I truly appreciate all your time and patience. I am trying to learn as I go and to be honest I was trying to use a range where you used resize in your last post so I was on the right track but like I said "I HAVE NO IDEA WHAT IM DOING" haha
 
Upvote 0
Actually I got it to paste data even time I run the the macro. with this:

Rich (BB code): 
 End If
        Worksheets(NmSTR).Activate
        Nm.Resize(, 500).Copy Range("C" & Rows.Count).End(xlUp).Offset(1)
    Next Nm

Now I Just need to paste in the dates from B1:B2 into each sheet in the correct spot (A:B) in the row where the data is pasted. Can you help me with that? @jbeaucaire
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Checking for Worksheets that already exist
2
Replies
11
Views
138
Logit
Logit
P
  • Solved
New Worksheet Hyperlinks
2
Replies
12
Views
164
Peter_SSs
Peter_SSs
B
  • Solved
Macro to Open new tab and duplicate the data from the template, and rename new tab from cell value of template.
Replies
3
Views
568
mumps
mumps
P
  • Solved
Copy and Re-Name Worksheet using a cell value.
Replies
3
Views
118
Logit
Logit
O
  • Solved
Copy a sheet which is a template based on a drop down list and rename each copied tab with each value in the drop down list
2 3
Replies
21
Views
1K
dmt32
D

Forum statistics

Threads
1,223,897
Messages
6,175,271
Members
452,628
Latest member
dd2

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top