Macro to copy all sheets and rename (VBA)

Hello

I want to make a macro in order to copy all the sheets of a drawing and rename them with the -SYM suffix (without knowing the name of the different sheets)

I did find this code to copy a sheet but I can't modify the code to copy and rename them all using a loop.

'----------------------------------------------------------
' Preconditions:
' 1. Open a drawing document containing one sheet
'    named Sheet1.
' 2. Open the Immediate window.
'
' Postconditions:
' 1. Activates Sheet1.
' 2. Copy and pastes Sheet1 as Sheet1(2) and activates Sheet1(2).
' 3. Copy and pastes Sheet1 as Sheet1(3) and activates Sheet1(3).
' 4. Examine the FeatureManager design tree and Immediate window.
'----------------------------------------------------------
Option Explicit

Dim swApp As SldWorks.SldWorks
Dim Part As DrawingDoc
Dim swModel As ModelDoc2
Dim boolstatus As Boolean

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set Part = swModel

    If (Part Is Nothing) Then
        MsgBox " Please open a drawing document. "
        End
    End If

    Dim currentsheet As Sheet
    Set currentsheet = Part.GetCurrentSheet
    Part.ActivateSheet (currentsheet.GetName)
    Debug.Print "Active sheet: " & currentsheet.GetName

    boolstatus = Part.Extension.SelectByID2("Feuille1", "SHEET", 0.09205356547875, 0.10872368523, 0, False, 0, Nothing, 0)
    swModel.EditCopy
    boolstatus = Part.PasteSheet(swInsertOption_BeforeSelectedSheet, swRenameOption_No)
    Set currentsheet = Part.GetCurrentSheet
    Part.ActivateSheet (currentsheet.GetName)
    Debug.Print "Active sheet: " & currentsheet.GetName

    boolstatus = Part.Extension.SelectByID2("Feuille1", "SHEET", 0.09205356547875, 0.10872368523, 0, False, 0, Nothing, 0)
    swModel.EditCopy
    boolstatus = Part.PasteSheet(swInsertOption_AfterSelectedSheet, swRenameOption_No)
    Set currentsheet = Part.GetCurrentSheet
    Part.ActivateSheet (currentsheet.GetName)
    Debug.Print "Active sheet: " & currentsheet.GetName

End Sub

 

Hello 

Here is an approach (it's not my specialty but I hope it will help),

(HS/ how do you paste a code?  /HS) 

 


copy_rename_sheet.png
1 Like

I'm testing this and I'll give you feedback, for the code it's this icon:

just choose the language then here VBScript.

1 Like

So simple that I don't even know how I could have missed it... Maybe the fatigue of last weekend!

Thank you @Lynk I will be able to continue my project, I had been stuck on this part for 3-4 hours.