Hi,

I have a macro that copy all sheet from a drawing and open new template and paste the sheets on. Then close old drawing and saveas the new one with the same name of the original one to overwrite it.

The problem is that I cannot save after the paste is done. It works for a while but not anymore and I change nothing.

Do you have any ideas ?

here my code..It works well with the part and assy section.. Thank you

Dim vSheetName As Variant
Dim SheetCount As Integer
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim PART As Object
Dim PARTTITLE As String
Dim X As String
Dim SWAPP As SldWorks.SldWorks
Dim swModel As ModelDoc2

Sub main()
Set SWAPP = Application.SldWorks
Set DOC = SWAPP.ACTIVEDOC
If DOC Is Nothing Then MsgBox "A SOLIDWORKS DOCUMENT MUST BE OPEN" & Chr(13) & "TO PERFORM REFRESH THIS WAY!!": End
Dim swDocTypeLong As Long
Set PART = SWAPP.ACTIVEDOC

X = PART.GetPathName

PARTTITLE = PART.GetTitle
      
  Set PART = SWAPP.ACTIVEDOC
Set swModel = SWAPP.ACTIVEDOC
Set SWDWG = swModel
Set swDraw = swModel
vSheetName = swDraw.GetSheetNames

SheetCount = PART.GetSheetCount
SWDWG.ActivateSheet vSheetName(SheetCount - (SheetCount))
PARTTITLE = PART.GetTitle
boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 1), "SHEET", 0, 0, 0, False, 0, Nothing, 0)
If SheetCount - 1 = 0 Then GoTo 8
boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 2), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
If SheetCount - 2 = 0 Then GoTo 8
boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 3), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
If SheetCount - 3 = 0 Then GoTo 8
boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 4), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
If SheetCount - 4 = 0 Then GoTo 8
boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 5), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
If SheetCount - 5 = 0 Then GoTo 8
boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 6), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
If SheetCount - 6 = 0 Then GoTo 8
boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 7), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
If SheetCount - 7 = 0 Then GoTo 8
boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 8), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
If SheetCount - 8 = 0 Then GoTo 8
boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 9), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
If SheetCount - 9 = 0 Then GoTo 8
boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 10), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
If SheetCount - 10 > 0 Then MsgBox "DRAWING COUNTAIN MORE THAN 10 SHEETS," & Chr(13) & "ONLY 10 FIRST WILL BE COPY," & Chr(13) & "SO CHECK TO MANUALLY COPY MISSING SHEETS."

8 PART.EditCopy
Set PART = SWAPP.NewDocument("s:\aaatemplates\solidworks 2010 template\DRAWING.drwdot", 12, 0.2794, 0.4318)
SWAPP.ActivateDoc2 "Draw7 - Sheet1", False, longstatus
 

Set PART = SWAPP.ACTIVEDOC
Dim myDrawingSheet As Object
Set myDrawingSheet = PART.GetCurrentSheet()
myDrawingSheet.SetName "SHEET TO DELETE"

Set PART = SWAPP.ACTIVEDOC
boolstatus = PART.Extension.SelectByID2("SHEET TO DELETE", "SHEET", 0, 0, 0, False, 0, Nothing, 0)
PART.Paste
  PARTTITLE2 = PART.GetTitle
 
SWAPP.CloseDoc PARTTITLE
Set PART = SWAPP.ActivateDoc2(PARTTITLE2, 0, 0)
'PART.Save2 (silent)
Set PART = SWAPP.ACTIVEDOC
longstatus = PART.SaveAs3(X, 0, 0)
   
End Sub