Oder du prüfst, ob das Datum schon existiert und machst wirklich einen Zähler hinten dran.

Sub Neues_Sheet()
  Dim shname As String, i As Long
  Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
  
  shname = Date
  i = 1
  Do While SheetExists(shname)
    i = i + 1
    shname = Date & "_" & i
  Loop
  sh.Name = shname
  
End Sub
Function SheetExists(Name As String) As Boolean
  On Error Resume Next
  SheetExists = IsObject(Sheets(Name))
End Function

Gruß Mr. K.