Problem with macro to copy then rename worksheets based on a list

[Ellen 2Excel]

Hello - this is my first post, so I hope I explain the issue clearly so someone can help me. I have a spreadsheet with two sheets (Sheet1=BaseDate) and (Sheet2=BaseTemplate). Sheet1 contains a list of user defined dates. I want to copy Sheet2 (BaseTemplate) for each named date in Sheet1, then rename these newly copied sheets according to the list defined on Sheet1. I am using an InputBox method for the user to identify the range in Sheet1. My macro runs fine and it is creating a new sheet for each name contained on Sheet1, but it is renaming them as BaseTemplate incrementally numbered. I am attaching my original spreadsheet, my spreadsheet after my code runs, and my VBA code. I'm not that experienced in VBA code and actually copied different macros until I got it do to what I wanted.

Original.xlsxAfter Macro.xlsx

Sub CreateDates()

Dim MyCell As Range
Dim MyRange As Range
Dim wsNew As Worksheet
Dim wsBaseTemplate As Worksheet

On Error Resume Next
        Application.DisplayAlerts = False

            Set MyRange = Application.InputBox(Prompt:="Please select the dates with your mouse.", Type:=8)

    On Error GoTo 0

        Application.DisplayAlerts = True

Set wsBaseTemplate = Sheets("BaseTemplate")
Application.ScreenUpdating = False

MyRange.Select
For Each MyCell In MyRange
wsBaseTemplate.Copy After:=Sheets(Sheets.Count)
Set wsNew = ActiveSheet
On Error Resume Next
wsNew.Name = MyCell.Value
On Error GoTo 0
Next MyCell

Application.ScreenUpdating = True

End Sub

[JBeaucaire]

Try it this way:

Option Explicit

Sub CreateSheetsFromDates()
Dim MyDates As Range, MyDate As Range

'make a range of all cells in column A with numbers in them, dates are numeric
Set MyDates = Sheets("BaseDates").Range("A:A").SpecialCells(xlConstants, xlNumbers)

For Each MyDate In MyDates
    If Not Evaluate("ISREF('" & CStr(MyDate.Text) & "'!A1)") Then   'make sure sheet doesn't exist already
        Sheets("BaseTemplate").Copy After:=Sheets(Sheets.Count)     'copy template
        ActiveSheet.Name = CStr(MyDate.Text)                        'name the new sheet
    End If
Next MyDate

End Sub