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

[grace12]

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.

 

[JLBURCH]

Hi Jbeaucaire
Thank you for your response! I receive the the error "Runtime Error ' 13 ' : Type mismatch".

The value of NmSTR is "", for Nm.Text as well.

I aranged everything allright, because it's creating the tabs with the correct names. But then it interrupts.
Thank you for your help!
BR J

 

[jbeaucaire]

Well there you go, the current cell being evaluated is blank, you can't test for a "blank" tab name. A good database doesn't have blank/null values in the key column you're using to create the tabs. Eliminate those blanks and the issue goes away.

 

[jbeaucaire]

Using the original code from post #12, something like this would skip blank value rows:

    For Each Nm In shNAMES                                      'check one name at a time
        If Len(Nm.Value) > 0 Then
            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
            With .Sheets(NmSTR)
                NR = .Range("C" & .Rows.Count).End(xlUp).Offset(1).Row
                wsMASTER.Range("B1:B2").Copy
                .Range("A" & NR).PasteSpecial xlPasteValues, Transpose:=True
                Nm.Resize(, 500).Copy .Range("C" & NR)
            End With
        End With
    Next Nm

 

[JLBURCH]

Great! Thank you soooo much! Works awesome Have a nice day!

 

[mky2016]

Hi there!


This is very useful!! It works but unfortunately doesn't fit all my needs... I'm totally new to coding and therefore would appreciate if jbeaucaire or anyone can help me fine tune the codes:


I would like the name on my "Master" sheet to be copied to a specific cell (B5) in the "Template" sheet first (so that it can look up some values from another database), and then copy this template (together with the values) to the newly created worksheet. Repeat the same for all the names on my "Master" sheet.


Can anyone help? thanks!

Try this:

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

 

[jbeaucaire]

Let me suggest a different solution. Put this formula into cell B5 on your template and it will always display the NAME of that sheet. As copies of the template sheet are made and renamed, this cell will update itself to the new name, too.

=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,256)

 

[mky2016]

THANKS!!! It works perfectly

Let me suggest a different solution. Put this formula into cell B5 on your template and it will always display the NAME of that sheet. As copies of the template sheet are made and renamed, this cell will update itself to the new name, too.

=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,256)

 

[MrNSC]

Hello everyone.
I would like to thank all the contributors on this thread. I've been using the code provided. To perfectly adjust to my needs, I need 2 additional features, if possible:

• On the created sheet I would like to manually fill some cells and automatically get those cells copied or linked over to the Master list, next to the cell that provided the name for created sheet.
  

• On the Master list, create a hyperlink on the name of the sheet created, directing to the created sheet.

Is it possible?

Thank you all in advance.

 

[jajukhan]

@jbeaucaire ... Thank you for your code. It really helped me a lot.

 

[Bracame]

Thank you for your code, very helpful

now I would like to create the new worksheet under condition:
We use the template as master (workeets'names to create are on column B3 to B48 for instance, like in your code) but we check the value of the column E, E3 to E48 for instance, if the value of E3= 1 than the worksheet with the name on B3 is created with your code if the value of E3 is null it is not created, etc until E48...
thank you to tell me where and how to insert this condition on your code ?

Try this:

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