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]

Like so:

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 wsMASTER.Range("E" & Nm.Row).Value = 1 Then                  'check row E for a 1
            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
        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

 

[sching]

Jbeaucaire thanks for this code. I would like some help in modifying it for my needs.

I want to take values from another column in the master sheet and paste them into a certain cell in my generated sheets.

 

[jbeaucaire]

Jbeaucaire thanks for this code. I would like some help in modifying it for my needs.

I want to take values from another column in the master sheet and paste them into a certain cell in my generated sheets.

Remember that the ROW we are using on the master sheet is currently stored in the value Nm.Row, which is how we are checking column E for a value of 1 on each row using the syntax:

If wsMASTER.Range("E" & Nm.Row).Value = 1 Then                  'check column E for a 1

So this tells you how to target the specific column to retrieve a value from the same row. You can insert that value into any cell on the newly created sheet.

Let's say for example you wanted to put the values from the master sheet in columns G and H in the new sheets in cells A1 and A2:

                With Sheets(CStr(Nm.Text))
                    .Range("A1").Value = wsMASTER.Range("G" & Nm.Row).Value
                    .Range("A2").Value = wsMASTER.Range("H" & Nm.Row).Value
                End With

You should now be able to adapt these two examples for your own needs and add as many others as needed. The entire section looks like this:

    For Each Nm In shNAMES                                              'check one name at a time
        If wsMASTER.Range("E" & Nm.Row).Value = 1 Then                  'check column E for a 1
            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
                With Sheets(CStr(Nm.Text))
                    .Range("A1").Value = wsMASTER.Range("G" & Nm.Row).Value
                    .Range("A2").Value = wsMASTER.Range("H" & Nm.Row).Value
                End With
            End If
        End If
    Next Nm

 

[ssembogga]

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

Wonderful code..exactly what i have been looking for in several days spending sleepless nights online. Thank you so much.

 

[manpais]

Hi @jbeaucaire, thank you so much for your code it really help me. But I need help to modify the codes to tackle my problem. Below is the details and link to my excel file.

Example.xlsm

Objective : Copy all transactions made by each ID and paste it in respective column in the table.

Steps I need to automate :

1. Input the statement date and create new sheets from template with respective IDs
2. If the date of the transaction (payment) is before and until the statement date, copy and paste all transactions up until the statement date.
3. If the date of the transaction (payment) is after the statement date, do not copy and paste transactions after the statement date.
4. The Principal Payment (in Master) will be paste on Debits column (in Template) and for the next payment will be paste two cells below the current. Same as for the Interest Payment.
5. The transaction date will be paste in Date column (in Template) for two rows

Remarks :

1. "Master" sheet is the transactions data
2. "Template" sheet is the sheet that will be fill up with the data
3. "101" sheet is the example of what the result will be if the steps above succeeded
4. "102" sheet is the result for the current automation I have done
5. I shared the link to download the file, do download it and try your codes

 

[Ibis2653]

Thank you for this it has been really helpful. I am running into a problem, I have the sheet protected and a button to run the code. when the sheet it protected I get an error saying it cant be run on a protected sheet. If I remove the .SpecialCells(xlConstants) from the set shNames line it will run but then I get a type mismatch error on the line If Not Evaluate("ISREF('" & NmSTR & "'!A1)") And wsMASTER.Range("G" & Nm.Row).Value = "Proceed" Then. The code works fine when unprotected. Thanks for your help

Option Explicit
Sub EvalSheetSummaryContractor()

'Create copies of a template sheet using text on a master sheet in a specific column
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shNAMES As Range, Nm As Range, NmSTR As String


Application.ScreenUpdating = False                              'stops the screen updating and make the code run faster
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("SUMMARY - CONTRACTORS")                    'sheet with names
                                                                'range to find names to be checked
    Set shNAMES = wsMASTER.Range("B4:B153").SpecialCells(xlConstants)     'or xlFormulas
  
    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)") And wsMASTER.Range("G" & Nm.Row).Value = "Proceed" Then       'if sheet does not exist and pre-requisite is proceed...
            wsTEMP.Copy After:=Sheets("Ranking")                 '...create it from template
            ActiveSheet.Name = NmSTR                            '...rename it
        End If
    Next Nm
  
    'orders the sheets the same as they appear on the summary page
   Dim MasterOrder As Collection
    Set MasterOrder = New Collection
  
    On Error Resume Next
    For Each Nm In shNAMES                                      'checks one name at a time
        MasterOrder.Add Sheets(Nm.Value), CStr(Nm.Value)        'checks where those sheets are in the master list
        Next Nm
        On Error GoTo 0
        Dim i As Long
        For i = 1 To MasterOrder.Count                                      'puts new sheets into a new collection
            Sheets(MasterOrder(i).Name).Move After:=Sheets(.Sheets.Count)   'moves the sheets to the end of all other sheets in order they appear on the summary page
        Next i
      
    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
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