Automatically create a spreadsheet for each cell from a selected range using a template sheet

Question

I have a simple question that I can't seem to solve. I just want to copy a template sheet for every selected cell from a range of cells and name each tab with their respective cell value. In this case the name will be just a date. When I make my range selection and run my code, it only copies the first cell that is being selected from that range. What change should I make to my code? TIA!

Sub copyAndRename()

Dim selectedcell As Long

    selectedcell = Range("A" & ActiveCell.Row).Value
    Sheets("Template").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Format(selectedcell, "m-dd-yy")
    ActiveSheet.Range("B6").Value = selectedcell
    
    
    'Stay on the same sheet
    Sheets("Daily Averages").Activate
    ActiveSheet.Cells(1, 1).Select
End Sub

Answer 1

Copy and Rename Worksheet

Sub CopyAndRename()

    If ActiveSheet Is Nothing Then
        MsgBox "No visible workbooks open.", vbCritical
        Exit Sub
    End If

    If Not TypeOf ActiveSheet Is Worksheet Then
        MsgBox "Not a worksheet (" & ActiveSheet.Name & ").", vbCritical
        Exit Sub
    End If
    
    If Not TypeOf Selection Is Range Then
        MsgBox "Not a range selected.", vbCritical
        Exit Sub
    End If
    
    Dim lws As Worksheet: Set lws = ActiveSheet
    
    Dim lrg As Range
    Set lrg = Intersect(Selection.EntireRow, lws.Columns("A"))

    Dim wb As Workbook: Set wb = lws.Parent
    Dim sws As Worksheet: Set sws = wb.Sheets("Template")
    
    Dim dsh As Object, lCell As Range, lValue, dName As String
    
    For Each lCell In lrg.Cells
        lValue = lCell.Value
        If IsDate(lValue) Then
            dName = Format(lValue, "m-dd-yyy")
            On Error Resume Next
                Set dsh = wb.Sheets(dName)
            On Error GoTo 0
            If dsh Is Nothing Then ' doesn't exist
                sws.Copy After:=wb.Sheets(wb.Sheets.Count)
                With wb.Sheets(wb.Sheets.Count)
                    .Name = dName
                    .Range("B6").Value = lValue
                End With
            Else ' already exists; do nothing
                Set dsh = Nothing
            End If
        End If
    Next lCell
        
    Application.Goto lws.Range("A1")
    
End Sub