Sub BlattKopieren()
      Dim NeuerName As String
      Dim i As Integer
      Do While NeuerName = ""
      NeuerName = InputBox("Please enter a new worksheet name!")
      Loop
      i = Sheets.Count
      Sheets("Vorlage").Copy After:=Sheets(i)
      ActiveSheet.Cells(6, 2) = NeuerName
      ActiveSheet.Name = CleanWorksheetName(NeuerName)
   End Sub

Function CleanWorksheetName(ByRef strName As String) As String
    Dim varBadChars As Variant
    Dim varChar As Variant
     
    varBadChars = Array(":", "/", "\", "?", "*", "[", "]")
     
     'correct string for forbidden characters
    For Each varChar In varBadChars
        Select Case varChar
        Case ":"
            strName = Replace(strName, varChar, vbNullString)
        Case "/"
            strName = Replace(strName, varChar, "-")
        Case "\"
            strName = Replace(strName, varChar, "-")
        Case "?"
            strName = Replace(strName, varChar, vbNullString)
        Case "*"
            strName = Replace(strName, varChar, vbNullString)
        Case "["
            strName = Replace(strName, varChar, "(")
        Case "]"
            strName = Replace(strName, varChar, ")")
        End Select
    Next varChar
     
     'correct string for worksheet length requirement
    strName = Left(strName, 31)
     
    CleanWorksheetName = strName
End Function