Require code to copy the selected worksheets and VBA modules to a new workbook in Excel

[Tuan Kriel]

Require code to copy any of the selected worksheets and VBA modules to a new workbook in Excel

 

[Trevor G]

It maybe easier to save the workbook as a copy and delete the sheets you don't need that way the VBA Modules are included without coding to copy the modules.

 

[Tuan Kriel]

It maybe easier to save the workbook as a copy and delete the sheets you don't need that way the VBA Modules are included without coding to copy the modules.

Thanks Trevor, this would not be viable as many different users will use the workbook as a template who would then like to select some worksheets applicable to them and save it in a different location every time.

 

[Trevor G]

How are you allowing your users to select the sheets and how do you know which modules to copy as well?

 

[John_w]

It maybe easier to save the workbook as a copy and delete the sheets you don't need that way the VBA Modules are included without coding to copy the modules.

Going with Trevor's suggestion - otherwise you have to change Macro settings to 'Trust access to the VBA project object model' in order to copy VBA modules - this macro prompts for the save file name and location and the newly saved workbook becomes the active workbook.

Public Sub Save_Selected_Sheets_In_New_Macro_Workbook()

    Dim sheetsList As String
    Dim sh As Object
    Dim saveAsFile As Variant
    
    With ThisWorkbook

        sheetsList = "|"
        For Each sh In ActiveWindow.SelectedSheets
            sheetsList = sheetsList & sh.Name & "|"
        Next
        
        saveAsFile = Application.GetSaveAsFilename(InitialFileName:="", FileFilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")

        If saveAsFile <> False Then
            .SaveAs saveAsFile, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Application.DisplayAlerts = False
            For Each sh In .Sheets
                If InStr(sheetsList, "|" & sh.Name & "|") = 0 Then
                    sh.Delete
                End If
            Next
            Application.DisplayAlerts = True
            .Save
        End If
        
    End With
    
End Sub

 

[Tuan Kriel]

Going with Trevor's suggestion - otherwise you have to change Macro settings to 'Trust access to the VBA project object model' in order to copy VBA modules - this macro prompts for the save file name and location and the newly saved workbook becomes the active workbook.

Public Sub Save_Selected_Sheets_In_New_Macro_Workbook()

    Dim sheetsList As String
    Dim sh As Object
    Dim saveAsFile As Variant
   
    With ThisWorkbook

        sheetsList = "|"
        For Each sh In ActiveWindow.SelectedSheets
            sheetsList = sheetsList & sh.Name & "|"
        Next
       
        saveAsFile = Application.GetSaveAsFilename(InitialFileName:="", FileFilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")

        If saveAsFile <> False Then
            .SaveAs saveAsFile, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Application.DisplayAlerts = False
            For Each sh In .Sheets
                If InStr(sheetsList, "|" & sh.Name & "|") = 0 Then
                    sh.Delete
                End If
            Next
            Application.DisplayAlerts = True
            .Save
        End If
       
    End With
   
End Sub

Thanks John, I've managed to solve it on my own see here below:

Sub CopySheetsComponentsModules() 'copies sheets/Thisworkbook/Userforms/Modules/Classes to a new workbook

'Stop - Go control
Dim answer As Integer
answer = MsgBox("Do you want to Continue?", vbQuestion + vbYesNo)

If answer = vbYes Then

Call TurnOffFunctionality_OCMIS

Dim src As CodeModule, dest As CodeModule
Dim i&
Dim WB_Dest As Workbook
'Dim sh As Worksheet
Dim Comp As VBComponent

'Set sh = ThisWorkbook.Sheets(1)
'sh.Cells.Clear

Set WB_Dest = Application.Workbooks.Add
On Error Resume Next 'needed for testing if component already exists in destination WorkBook and for cross-references.
For Each Comp In ThisWorkbook.VBProject.VBComponents

'i = i + 1
'sh.Cells(i, 1).Value = Comp.Name

'Set Source code module
Set src = Comp.CodeModule 'ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule

'test if destination component exists first
i = 0: i = Len(WB_Dest.VBProject.VBComponents(Comp.Name).Name)
If i <> 0 Then 'or: if err=0 then
Set dest = WB_Dest.VBProject.VBComponents(Comp.Name).CodeModule
Else 'create component
With WB_Dest.VBProject.VBComponents.Add(Comp.Type)
.Name = Comp.Name
Set dest = .CodeModule
End With
End If

'copy module/Form/Sheet/Class 's code:
dest.DeleteLines 1, dest.CountOfLines
dest.AddFromString src.Lines(1, src.CountOfLines)

Next Comp

'Add references as well :
Dim Ref As Reference
For Each Ref In ThisWorkbook.VBProject.References
'Debug.Print Ref.Name 'Nom
WB_Dest.VBProject.References.AddFromFile Ref.FullPath
'Debug.Print Ref.FullPath 'Chemin complet
'Debug.Print Ref.Description 'Description de la référence
'Debug.Print Ref.IsBroken 'Indique si la référence est manquante
'Debug.Print Ref.Major & "." & Ref.Minor 'Version
'Debug.Print "---"
Next Ref

Err.Clear: On Error GoTo 0

'Copy selected sheets to the new workbook
ThisWorkbook.Activate
ActiveWindow.SelectedSheets.Copy after:=WB_Dest.Sheets(1)
ThisWorkbook.Sheets(Array("Summary", "OCMIS-BOM")).Copy after:=WB_Dest.Sheets(1)

WB_Dest.Activate
WB_Dest.Sheets(1).Delete
Sheets("Summary").Visible = xlSheetHidden

Set Ref = Nothing
Set src = Nothing
Set dest = Nothing
Set Comp = Nothing
Set WB_Dest = Nothing

Call TurnOnFunctionality_OCMIS
Else

End If
End Sub