Hi,
I'm having trouble moving a worksheet to a new workbook and then saving
it to a specific file. The error I'm getting is:

run-time error '-2147221080 (800401a8)':
Automation error.

I have googled and came up with a couple of ideas I adapted and thought
would work but they each still generate the same error. I'm out of
ideas.

Here is my Code:

Private Sub cmdSubCOCopySave_Click()
Dim c As Range, d As Range
Dim NewSht As Worksheet
Dim obj As OLEObject
Dim myshape As Shape
Dim MyPath As String
Dim Str As Variant, Str2 As Variant
Dim Str3 As Variant, Fname As Variant

Call SendToSubConDB 'Tranfers pertinent data to database

Str = ActiveSheet.Range("SubConName").Value
Str2 = "CO " & ActiveSheet.Range("SubCon_CHANGE_ORDER_NO").Value
Str3 = ActiveSheet.Range("ProjectSubVen").Value
Fname = Str & " " & Str2 & " " & Str3
On Error Resume Next
MkDir ThisWorkbook.Path & "\Subcon-Vendor CO\"
MyPath = ThisWorkbook.Path & "\Subcon-Vendor CO\"

ActiveSheet.Move
Set NewSht = ActiveSheet
On Error GoTo 0
Application.Dialogs(xlDialogSaveAs).Show MyPath & Fname & ".xls"
'ActiveWorkbook.SaveAs Filename:=MyPath & Fname & ".xls" This
didn't work either

Application.ScreenUpdating = False
Application.EnableEvents = False

With NewSht
Unprotect ("geekk")
On Error Resume Next
OLEObjects.Visible = True
OLEObjects.Delete
For Each myshape In NewSht.Shapes
Select Case myshape.Type
Case 1: myshape.Delete
Case 17: myshape.Delete
End Select
Next myshape
On Error GoTo 0
Set d = NewSht.Cells.SpecialCells(xlCellTypeFormulas)
For Each c In d
With c
Value = .Value
End With
Next c
Protect ("geekk")
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


--
Casey


------------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=559327