Sub Blattspeichern()
Dim sPath As String, sWks As String, sFile As String
Application.ScreenUpdating = False
sPath = ActiveWorkbook.Path & "\"
Dim Default
sWks = "Test"
If sWks = "" Then Exit Sub
Titel = "InputBox"
Mldg = "Dateiname eingeben"
sFile = InputBox(Mldg, Titel)
prompt = "Blattname"
If sFile = "" Then Exit Sub
ActiveSheet.Copy
ActiveSheet.Name = sWks
ActiveWorkbook.SaveAs sPath & sFile
Application.ScreenUpdating = True
End Sub