VBA - Copy template and create new sheets

[csimonds]

Hi,
I have the below code shared by another user that I am using to create new sheets from a list of names in Sheet, 1.EMPLOYEES copying a template sheet, MASTER.
The below code does this well, however I need help to add another step.

In Sheet "1.EMPLOYEES" the name of the sheets is taken from Col. D
When a new sheet is created from the MASTER template and named according to the name in Col. D of sheet 1.EMPLOYEES I would like the value (Employee #) to be copied into cell B3 of the new sheet. Employee # is contained in Col F of sheet 1.EMPLOYEES

The overall logic of the macro is to create a new sheet from a template, name it after the data in Col. D of sheet 1.EMPLOYEES and add the employee number to the new sheet where the employee number is found in Col. F of sheet 1.EMPLOYEES

Any help would be appreciated.
Thanks,

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

With ThisWorkbook                                          
Set wsTEMP = .Sheets("MASTER")                             
wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)            
If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      

Set wsMASTER = .Sheets("1.EMPLOYEES")            
Set shNAMES = wsMASTER.Range("D2:D" & Rows.Count).SpecialCells(xlConstants)     

Application.ScreenUpdating = False                              
For Each Nm In shNAMES                                          
If Not Evaluate("ISREF('" & CStr(Nm.Text) & "'!A1)") Then   
wsTEMP.Copy After:=.Sheets(.Sheets.Count)               
ActiveSheet.Name = CStr(Nm.Text)                       
End If    
Next Nm        

wsMASTER.Activate                                          
If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden       
Application.ScreenUpdating = True                         
End With

MsgBox "All sheets created"
End Sub

 

[DanteAmor]

I made some small adjustments to your code, I hope not to confuse you, it would look like this:

Sub SheetsFromTemplate()
  Dim wsMASTER As Worksheet, wsEMPLOY As Worksheet, NewSheet As Worksheet, Nm As Range
  Application.ScreenUpdating = False
  Set [COLOR=#0000cd]wsMASTER [/COLOR]= Sheets("[COLOR=#0000cd]MASTER[/COLOR]")
  Set [COLOR=#008000]wsEMPLOY [/COLOR]= Sheets("1.[COLOR=#008000]EMPLOYEES[/COLOR]")
  wsMASTER.Visible = xlSheetVisible
  For Each Nm In wsEMPLOY.Range("D2", wsEMPLOY.Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlConstants)
    If Not Evaluate("ISREF('" & CStr(Nm.Text) & "'!A1)") Then
      wsMASTER.Copy After:=Sheets(Sheets.Count)
      Set NewSheet = ActiveSheet
      NewSheet.Name = CStr(Nm.Text)
[COLOR=#b22222]      NewSheet.Range("B3") = Nm.Offset(, 1)[/COLOR]
    End If
  Next Nm
  wsMASTER.Visible = xlSheetHidden
  Application.ScreenUpdating = True
  MsgBox "All sheets created"
End Sub