尝试

Sub CreateAndRenameSheets()
    Dim selectedCell As Range
    Dim dailyAveragesSheet As Worksheet
    
    ' Set the reference to the "Daily Averages" sheet
    Set dailyAveragesSheet = ThisWorkbook.Worksheets("Daily Averages")
    
    ' Loop through each selected cell
    For Each selectedCell In Selection
        
            ' Copy the "Template" sheet
            ThisWorkbook.Worksheets("Template").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            
            ' Rename the copied sheet to the value of the selected cell
            ActiveSheet.Name = Format(selectedCell, "m-dd-yy")
            
            ' Put the selected cell value in range B6 of the copied sheet
            ActiveSheet.Range("B6").Value = selectedCell.Value
    Next selectedCell
    
    ' Go back to the "Daily Averages" sheet
    dailyAveragesSheet.Activate
    dailyAveragesSheet.Range("A1").Select
End Sub

字符串

复制重命名工作表

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

字符串