Create worksheet based on selected row

[rikvny02]

The below code creates a worksheet for each row of data on the Options tab. Works great!!!!

- My question is, Is there a way to choose a single row and only create that new worksheet.
-There can be 50-100 sheets already made but if a new employee starts Id only like to create that one sheet.
- Or maybe adjust the code to loop and check for pre existing tabs and only create if a tab doesn't exist.

main sheet of data

example of results

Sub CreateSheets()

Dim dws As Worksheet
Dim tws As Worksheet
Dim lr As Long
Dim r As Long
Dim emp As String

Application.ScreenUpdating = False

' Set Data and Template worksheets
Set dws = Sheets("Options")
Set tws = Sheets("td32")

' Find last row in column b on "Data" sheet
lr = dws.Cells(dws.Rows.Count, "b").End(xlUp).Row

' Exit if no data
If lr < 5 Then
MsgBox "No data on data sheet", vbOKOnly, "ABORTING MACRO"
Exit Sub
End If

' Loop through all rows on data sheet
For r = 5 To lr
' Get name of emp
emp = dws.Cells(r, "e")
' Insert new sheet and rename it
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = emp
' Copy over template to new sheet
Sheets("td32").Select
Cells.Copy
Sheets(emp).Select
ActiveSheet.Paste
' Copy data over from Data sheet to Emp sheet
Sheets(emp).Range("C2") = emp 'EMP name
Sheets(emp).Range("c1") = dws.Cells(r, "f") 'NAME #
Sheets(emp).Range("c4") = dws.Cells(r, "b") 'DOB
Sheets(emp).Range("j1") = dws.Cells(r, "g") 'ADDRESS
Sheets(emp).Range("j2") = dws.Cells(r, "h") 'city
Sheets(emp).Range("j3") = dws.Cells(r, "l") 'phone



Next r

Application.ScreenUpdating = True

 

[rikvny02]

How can i manipulate the below code into the above code?


Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range

Set MyRange = Range(Sheets("options").[e5], Sheets("options").Cells(Rows.Count, "e").End(xlUp))

For Each MyCell In MyRange
If Len(MyCell.Text) > 0 Then
'Check if sheet exists
If Not sheetExists(MyCell.Value) Then
Sheets.Add after:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
End If
End If
Worksheets("td32").Cells.Copy ActiveSheet.Range("a1")
Next MyCell
End Sub

 

[rikvny02]

@Fluff - can you provide some help. I'm trying to combine the two above macros.