Private Sub SaveWorkbookAsNewFile()
Dim ActSheet As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFileType As String
Dim NewFile As String

NewFileName = "TestNew"
Application.ScreenUpdating = False ' Prevents screen refreshing.

CurrentFile = ThisWorkbook.FullName

NewFileType = "Excel Files 1997-2003 (*.xls), *.xls," & _
"Excel Files 2007 (*.xlsx), *.xlsx," & _
"All files (*.*), *.*"

NewFile = Application.GetSaveAsFilename( _
InitialFileName:=NewFileName, _
fileFilter:=NewFileType)

If NewFile <> "" And NewFile <> "False" Then
ActiveWorkbook.SaveAs Filename:=NewFile, _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

Set ActBook = ActiveWorkbook
Workbooks.Open CurrentFile
ActBook.Close
End If

Application.ScreenUpdating = True
End Sub