Option Explicit
Dim OldWorksheetName As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngChk As Range, rngTarget As Range, sSheetName As String
Dim wsh As Worksheet, wshNew As Worksheet
With Target.Worksheet
Set rngChk = .Range(.Range("D10"), .Cells(.UsedRange.Rows.Count + UsedRange.Row, 4))
For Each rngTarget In Target.Cells
If Not Intersect(rngTarget, rngChk) Is Nothing Then
sSheetName = rngTarget.Cells(1, 1).Value
If sSheetName = "" Then
If Not OldWorksheetName = "" Then
Set wshNew = GetWorksheet(ThisWorkbook, OldWorksheetName)
If Not wshNew Is Nothing Then
Application.DisplayAlerts = False
wshNew.Delete
Application.DisplayAlerts = True
OldWorksheetName = ""
End If
End If
Else
If Not OldWorksheetName = "" Then
Set wshNew = GetWorksheet(ThisWorkbook, OldWorksheetName)
If Not wshNew Is Nothing Then
wshNew.Name = sSheetName
End If
Else
Set wsh = GetWorksheet(ThisWorkbook, sSheetName)
If wsh Is Nothing Then
Template.Copy After:=Target.Worksheet
Set wshNew = SearchHiddenWorkbook(ThisWorkbook, Template)
wshNew.Name = sSheetName
wshNew.Visible = xlSheetVisible
wshNew.Activate
End If
End If
End If
End If
Next
End With
End Sub
Private Function SearchHiddenWorkbook(wbk As Workbook, wshTemplate As Worksheet) As Worksheet
Dim wsh As Worksheet
For Each wsh In wbk.Worksheets
If Not wsh.Visible = xlSheetVisible Then
If Left(wsh.Name, Len(wshTemplate.Name)) = wshTemplate.Name Then
Set SearchHiddenWorkbook = wsh
Exit For
End If
End If
Next
End Function
Private Function GetWorksheet(wbk As Workbook, sName As String) As Worksheet
Dim wsh As Worksheet
With wbk
For Each wsh In wbk.Worksheets
If wsh.Name = sName Then
Set GetWorksheet = wsh
Exit For
End If
Next
End With
End Function
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngChk As Range, rngTarget As Range
Dim wsh As Worksheet, wshNew As Worksheet
With Target.Worksheet
Set rngChk = .Range(.Range("D10"), .Cells(.UsedRange.Rows.Count + UsedRange.Row, 4))
For Each rngTarget In Target.Cells
If Not Intersect(rngTarget, rngChk) Is Nothing Then
OldWorksheetName = rngTarget.Value
End If
Next
End With
End Sub