Hi

The following code entered into the ThisWorkbook module could be used.

You will need to amend to suit your circumstances, and add some checks to
ensure the user doesn't add .xls to the end of the name they give etc., but
it should get you started

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Dim filename As String, oldname As String
oldname = ThisWorkbook.Name
Application.EnableEvents = False
entername:
filename = ""
filename = InputBox ("Enter a NEW Filename to save this file as")
filename = filename & ".xls"
If oldname = filename Then
MsgBox ("You have chosen the same name  " & oldname & vbCr _
& " Choose something different")

GoTo entername
End If
ThisWorkbook.SaveAs filename
Application.EnableEvents = True
End Sub