Hello Friends
I am getting "Run Time Error 'SaveAs' of object'_Workbook Failed" error with below code, can you please check & let me know the solutions.
Private Sub CommandButton1_Click() ' Print Final
'######### COPY Purchase Order No.###################################################################3
Dim LastRow As String
Dim I As Long
If Sheets("Purchase Order").Range("J1") = "" Then
UserForm2.Show
Exit Sub
End If
If Sheets("Purchase Order").Range("J1") = "T9 - SEZ" Then
LastRow = Sheets("PO Numbers").Range("A1048576").End(xlUp).Row + 1
Sheets("PO Numbers").Range("A" & LastRow).Value = Sheets("Purchase Order").Range("K1").Value
I = I + 1
End If
If Sheets("Purchase Order").Range("J1") = "T8 - SEZ" Then
LastRow = Sheets("PO Numbers").Range("B1048576").End(xlUp).Row + 1
Sheets("PO Numbers").Range("B" & LastRow).Value = Sheets("Purchase Order").Range("K1").Value
I = I + 1
End If
If Sheets("Purchase Order").Range("J1") = "T9 - STPI" Then
LastRow = Sheets("PO Numbers").Range("C1048576").End(xlUp).Row + 1
Sheets("PO Numbers").Range("C" & LastRow).Value = Sheets("Purchase Order").Range("K1").Value
I = I + 1
End If
'#####################Save Excel Copy####################################
Dim FileName As String
Dim FilePath1 As String
Dim FilePath2 As String
Dim FilePath3 As String
Dim NewBook As Workbook
FilePath1 = "P:\2014-15\Tower 8 - SEZ\" ' Mapped Drive
FilePath2 = "P:\2014-15\Tower 9 - SEZ\" ' Mapped Drive
FilePath3 = "P:\2014-15\Tower 9 - STPI\" ' Mapped Drive
FileName = "0" & Sheets("Purchase Order").Range("L1") & "-" & Sheets("Purchase Order").Range("B5") & ".xlsx"
If Sheets("Purchase Order").Range("J1") = "" Then
UserForm2.Show
Exit Sub
End If
If Dir(FilePath1 & "\" & FileName) <> "" Then
MsgBox "File " & FilePath1 & "\" & FileName & " already exists", vbInformation
Exit Sub
Else
If Dir(FilePath2 & "\" & FileName) <> "" Then
MsgBox "File " & FilePath2 & "\" & FileName & " already exists", vbInformation
Exit Sub
Else
If Dir(FilePath3 & "\" & FileName) <> "" Then
MsgBox "File " & FilePath3 & "\" & FileName & " already exists", vbInformation
Exit Sub
Else
Set NewBook = Workbooks.Add
ThisWorkbook.Sheets("Purchase Order").Copy before:=NewBook.Sheets(1)
Application.DisplayAlerts = False
If Sheets("Purchase Order").Range("J1") = "T8 - SEZ" Then
NewBook.SaveAs FileName:=FilePath1 & FileName
Else
If Sheets("Purchase Order").Range("J1") = "T9 - SEZ" Then
NewBook.SaveAs FileName:=FilePath2 & FileName
Else
If Sheets("Purchase Order").Range("J1") = "T9 - STPI" Then
NewBook.SaveAs FileName:=FilePath3 & FileName
End If
End If
End If
End If
End If
NewBook.Activate
On Error Resume Next
ActiveSheet.OLEObjects.Visible = True
ActiveSheet.OLEObjects.Delete
On Error GoTo 0
Application.Goto Reference:="R1C1:R100C8"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.Goto Reference:="R1C1"
NewBook.Save
NewBook.Close
End If
'##################### End Save Excel Copy ####################################
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
'IgnorePrintAreas:=False
'Sheets("Purchase Order").Range("J1,B5") = Clear
End Sub
Thanks
Vaibhav
Bookmarks