Sub ExportWorkbook()
   Dim varFileName As Variant
   Dim strRestrictedName As String

   On Error GoTo Err_Handler

   strRestrictedName = ActiveWorkbook.Name

   Application.EnableEvents = False
   varFileName = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path & "\", fileFilter:="Microsoft Office Excel Workbook (*.xls), *.xls")
   varFileName = Mid$(varFileName, InStrRev(varFileName, "\") + 1)

   If varFileName < False Then
      If UCase$(varFileName) < UCase$(strRestrictedName) Then
          ActiveWorkbook.SaveAs varFileName
          Application.EnableEvents = True
          FormulasToValues (varFileName)
          ActiveWorkbook.Save
          MsgBox "Done"
      Else
          MsgBox "Invalid File Name", vbCritical, "Stop"
      End If
   Else
       ' Cancelled Save As dialog
   End If
   Application.EnableEvents = True

Err_Exit:
   Application.EnableEvents = True
   Exit Sub
Err_Handler:
   Select Case Err
       Case 1004 ' Cancelled overwrite of existing file in Save As msgbox
           ' do nothing
       Case Else
           MsgBox Err & " " & Err.Description
   End Select
   GoTo Err_Exit
End Sub

Sub FormulasToValues(WkbName As String)
   Dim ws As Worksheet
   Dim wkb As Workbook

   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual

   Set wkb = Application.Workbooks(WkbName)
 For Each ws In wkb.Worksheets
       With ws
           .Activate
           On Error Resume Next
           .ShowAllData
           .AutoFilterMode = False
           Worksheets(ws).ShowAllData = True
           On Error GoTo 0
           .Cells.Select
            Selection.Copy
            Selection.PasteSpecial xlPasteValuesAndNumberFormats
            Selection.PasteSpecial xlFormats
            Selection.PasteSpecial xlPasteColumnWidths
       End With
       ws.Range("A1").Select
       Application.CutCopyMode = False
   Next
   Sheets(1).Activate

   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
End Sub