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.

 

[jbeaucaire]

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

 

[grace12]

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

Thank you @jbeaucaire .. Works perfectly. Cant thank you enough!

 

[jbeaucaire]

Here's another update used to insure the sheetnames are the correct length and do not include any illegal characters:

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

 

[pyrokidd89]

Here's another update used to insure the sheetnames are the correct length and do not include any illegal characters:

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

@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?

 

[jbeaucaire]

Maybe this addition:

        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

 

[pyrokidd89]

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

	A	B	C	D
1	start	yymmdd
2	end	YYMMDD
3
4
5		param1	param2	param3
6		units	units	units
7	subject1	A	B	C
8	subject2	E	F	G
9	subject3	I	J	K
10	subject4	M	N	O
11	subject5	Q	R	S

<colgroup><col width="25px" style="background-color: #DAE7F5" /><col /><col /><col /><col /></colgroup><thead> </thead><tbody> </tbody>

Input​

Excel 2012

	A	B	C	D	E	F
17
18	DATA			param1	param2	param3
19	start date	end date	subject	units	units	units
20
21

<colgroup><col width="25px" style="background-color: #DAE7F5" /><col /><col /><col /><col /><col /><col /></colgroup><thead> </thead><tbody> </tbody>

Template​

This is the result im looking for: Excel 2012

	A	B	C	D	E	F
17
18	DATA			param1	param2	param3
19	start date	end date	subject	units	units	units
20	yymmdd	YYMMDD	subject1	A	B	C
21

<colgroup><col width="25px" style="background-color: #DAE7F5" /><col /><col /><col /><col /><col /><col /></colgroup><thead> </thead><tbody> </tbody>

subject1​

 

[jbeaucaire]

Is this better:

        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

 

[pyrokidd89]

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

 

[pyrokidd89]

Actually I got it to paste data even time I run the the macro. with this:

 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