give this a try
Sub MyMacro()
Dim WS As Worksheet
Dim MyDay As String
Dim MyMonth As String
Dim MyYear As String
Dim MyPath As String
Dim MyFileName As String
Dim MyCellContent As Range
MyDay = Day(Date)
MyMonth = Month(Date)
MyYear = Year(Date)
MyPath = "C:\INVOICES"
Set WS = ActiveSheet
Set MyCellContent = WS.Range("G13")
MyFileName = "Invoice_" & MyCellContent & "_" & MyDay & "." & MyMonth & "." & MyYear & ".xls"
WS.Copy
ChDir MyPath
If CInt(Application.Version) <= 11 Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
MyFileName, _
ReadOnlyRecommended:=True, _
CreateBackup:=False
Else
Application.DisplayAlerts = False
If Len(Dir(MyPath & "\" & MyFileName)) > 0 Then
If MsgBox("File exists, do you want to over write", vbYesNo) = vbYes Then
ActiveWorkbook.SaveAs Filename:= _
MyFileName, FileFormat:=xlExcel8, _
ReadOnlyRecommended:=True, _
CreateBackup:=False
'Invoice Details Cleared
MsgBox "Invoice Saved. Click New Invoice Number."
Else
MsgBox "Invoice not Saved. Click New Invoice Number."
End If
Else
ActiveWorkbook.SaveAs Filename:= _
MyFileName, FileFormat:=xlExcel8, _
ReadOnlyRecommended:=True, _
CreateBackup:=False
'Invoice Details Cleared
MsgBox "Invoice Saved. Click New Invoice Number."
End If
End If
ActiveWorkbook.Close
End Sub