Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim lr&, i&, c&, cell As Range, nameS(1 To 100000, 1 To 2)
Dim ws As Worksheet, temp As Worksheet
If Target.Column = 1 And Target.Row > 2 Then
lr = Cells(Rows.Count, "A").End(xlUp).Row
Set temp = Worksheets("Template")
For Each cell In Target
If Not IsEmpty(cell) And WorksheetFunction.CountIf(Range("A3:A" & lr), cell) > 1 Then
MsgBox "Dupplicate name. Try again"
Target.ClearContents
Exit Sub
End If
Next
For Each ws In Sheets
If ws.name <> "Master" And ws.name <> "Template" Then
If lr = 2 Then
ws.Delete
Else
i = i + 1
nameS(i, 1) = ws.name
End If
End If
Next
For Each cell In Range("A3:A" & lr)
If lr = 2 Then Exit Sub
If Not IsEmpty(cell) Then
For Each ws In Sheets
If ws.name <> "Master" And ws.name <> "Template" And ws.name = cell.Value Then GoTo z:
Next
temp.Copy after:=Sheets(Sheets.Count)
ActiveSheet.name = cell.Value
ActiveSheet.Range("A1").Value = cell.Value
Worksheets("Master").Activate
End If
z:
Next
For Each ws In Sheets
If ws.name <> "Master" And ws.name <> "Template" And _
WorksheetFunction.CountIf(Range("A3:A" & lr), ws.name) = 0 Then ws.Delete
Next
End If
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If IsEmpty(Target) Or Target.Count > 1 Or Target.Row < 3 Or Target.Column <> 1 Then Exit Sub
Worksheets(Target.Value).Activate
End Sub