save first sheet only

[stevesunfold]

hi guys sorry to bug you all again but i really need to get this done for my boss and im at my wits end
i have tried to change this code to save just the first sheet
and was wondering if anyone could hel me fulfil this as i keep getting an error
i will make the code red as to what i have changed

Sub COPYandPRINT()
Sheet1.Unprotect Password:="contracts"
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=False
     
     With Sheets("PURCHASE ORDER NUMBERS")
       R = .Cells(Rows.Count, "A").End(xlUp).Row + 1
       .Cells(R, "A") = PONUMBER
       .Cells(R, "B") = SUPPLIER
       .Cells(R, "C") = xDATE
       .Cells(R, "D") = JOBNUMBER
       .Cells(R, "E") = CUSTOMERNAME
       .Cells(R, "F") = DESCRIPTION
     End With
     
     Application.ScreenUpdating = True
     Application.DisplayAlerts = False
    
     SaveJobFile
     
End Sub

Sub SaveJobFile()
 'declare all variables
  Dim stOfPath As String
  Dim ActualMidFolder As String
  Dim EndOfNameAndPath As String
  Dim FileNameToSave As String
  Dim JobNum As String
  Dim PONum As String
  Dim SuppliersName As String

  'define initial variables (note: the ranges may need to be changed
    JobNum = Range("G23").Value
    PONum = Worksheets("Purchase Order").Range("$K$12").Text
    SuppliersName = Range("B16")
    EndOfNameAndPath = SuppliersName & " Purchase Order " & PONum & Format(Date, " dd.mm.yy") & ".xls"

  'test to see if it is stock or PO (?) & define the saving path accordingly
    Select Case UCase(Left(JobNum, 1)) = "J"
        Case True
  'Rob's test path:     stOfPath = "C:\Documents and Settings\HP_Owner\My Documents\"
            stOfPath = Range("B69") & "\"
            'test for any likely folders
                If Not (DoesFileFolderExist(stOfPath & JobNum & "*")) Then GoTo TheEnd
            'identify the exact folder
                ActualMidFolder = GetActualFolderName(stOfPath, JobNum) & "\"
            'define rest of file name
                EndOfNameAndPath = "Docs\" & EndOfNameAndPath
                FileNameToSave = stOfPath & ActualMidFolder & EndOfNameAndPath
        Case False
            stOfPath = Range("B70") & "\"
            If Not (DoesFileFolderExist(stOfPath)) Then GoTo TheEnd
                FileNameToSave = stOfPath & EndOfNameAndPath
    End


  'save the file & finish macro
    SelectSheet1.Copy    ActiveWorkbook.SaveAs Filename:=FileNameToSave
    ActiveWorkbook.Close True
    
     With Worksheets("purchase order")
       .Range("B16:F19,K17:L20,B23:C24,C29:C57,G23:H24,I23:K24,E29:J57").ClearContents
       PONUMBER = PONUMBER + 1
       .Cells(12, "K") = PONUMBER
       .Activate
       .Range("B16").Select
       Sheet1.Protect Password:="contracts"
       
           ChDir "C:\Documents and Settings\steve taylor\Desktop"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\steve taylor\Desktop\PURCHASE ORDER DONE AND DUSTED.xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
     End With

    Exit Sub

TheEnd:
  'warn nothing exists & end the macro
    MsgBox "Macro ending b/c no Folder with the following number exists : " & stOfPath & JobNum & "*", , "FYI"
    Debug.Print stOfPath & JobNum & "*"
End Select


Public Function DoesFileFolderExist(strfullpath As String) As Boolean
'sourced from www.excelguru.ca/node/30 by Ken Puls
'note it only checks for the existence of the lowest folder (or the file) in the strfullpath string.
If Not Dir(strfullpath, vbDirectory) = vbNullString Then DoesFileFolderExist = True
End Function

Function GetActualFolderName(StartOfPath As String, StartOfFuzzyFolder As String)
'sourced & modified from http://www.themssforum.com/ExcelProgramming/parent-folder/
Dim oFSO As Object
Dim SubDirectory
Set oFSO = CreateObject("Scripting.FileSystemObject")
With oFSO.GetFolder(StartOfPath)
    For Each SubDirectory In .SubFolders
        If UCase(Left(SubDirectory.Name, Len(StartOfFuzzyFolder))) = UCase(StartOfFuzzyFolder) Then
            GetActualFolderName = SubDirectory.Name
            Exit For
        End If
    Next SubDirectory
End With
'free memory
Set oFSO = Nothing

End Function