SaveAs macro saves the whole workbook and not just sheets

[mycomputerguy-w]

Im sure its nothing more than a code line im missing. I'll try to explain what this macro is doing first and then what id like it to do. Bear in mind that as it is now is ok, it works but it doesnt work to the best efficency.

When the user clicks the "Save Record" command button. This macro checks first to see if the cell b670 is filled, if not, it pops a message and asks to have the field filled and exits, if the cell is filled, then whatever is in the cell is what the filename will be. The same thing happens for cell B672 except that cell will be the sub directory under the default path. Once that is done it saves the work book, clears the 2 cells and, returns to the SAVED sheet. So here is what its missing. 1st, it saves the WHOLE workbook and id like it to save just the active sheet called 'Order Summary' and 1 other sheet called 'Order Entry'. 2nd Id like it to save them as a copy to the main workbook I am currenty working in and have it remain in that workbook rather than revert to the copy it just saved. I can attach a copy of the workbook to look at if that will help to understand the problem a little better, for now, here is the macro code:

Sub SaveAs() 
    If Range("B670") = "" Then 
        MsgBox ("Please fill in Boat Number.") 
        Exit Sub 
    ElseIf Range("B672") = "" Then 
        MsgBox ("Please fill in Company Name.") 
        Exit Sub 
    End If 
    Dim strFilename, strDirname, strPathname, strDefpath As String 
    On Error Resume Next ' If directory exist goto next line
    strDirname = Range("B672").Value ' New directory name will be whatever is put into this cell
    strFilename = Range("B670").Value 'New file name will be whatever is in this cell
    strDefpath = "C:\Users\Bench\Desktop\Order Entry\" 'Default path name
    If IsEmpty(strDirname) Then Exit Sub 
    If IsEmpty(strFilename) Then Exit Sub 
    MkDir strDefpath & strDirname 
    strPathname = strDefpath & strDirname & "\" & strFilename 'create total string
    ActiveWorkbook.SaveAs.Copy Filename:=strPathname, _ 
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ 
    ReadOnlyRecommended:=False, CreateBackup:=False 
    For Each Cell In Range("B670:B672") 
        If Cell > 0 Then Cell.ClearContents 
    Next 
    MsgBox ("Record Saved.") 
End Sub 

[venkat1926]

the save as portion may be changed like this

Sub test() 
    Dim path As String, namefile As String 
    path = "E:\excel\" 
     'change the path to suit you
    namefile = "tempo" 
     'change namefile to your wishes
    ActiveSheet.Copy 
     'tghe above is important code in this
    ActiveWorkbook.SaveAs path & namefile & ".xls" 
     '.xls is for excel 2003 or earlier
     
End Sub