How do I duplicate an excel workbook and all of the code inside it

KaD 0
Viewed 61

I am having a bit of brain freeze moment. I need to copy a workbook including all of its VBA code. I then need to delete from the workbook a couple of sheets. I know that I can just create a new workbook and copy the sheets to that new wb however I need the code for the entire wb to go with it.

I also know that I could do a workbook save copy as.
However it will be random people saving it to their computer and so how do I know how to refer to this book in order to then delete the sheets?

I feel like it is so easy, but I don't know enough to figure it out.
Thanks for your help!

vba excel
2 Answers

I believe you are worrying far to much about the fact that the file you want to copy is a workbook with all its macros, ...

You can, as far as the copying is concerned, simply treated as any other file, like this:

Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile "C:\Temp_Folder\Test.txt", "C:\Temp_Folder\Test2.txt2"

This works for any kind of file (Excel files, included). Once you have done this, you can open the copied file and remove some sheets and so on.

Dominique0

You can copy this code to your new button_click routine

I tested it and it works for me.

Change Sheet3 and Sheet4 to meet your own needs.

The folder dialog code came from here.

Option Explicit

'Private Sub button_click()
Private Sub test73622125()

Dim fldr As FileDialog, fso As Object
Dim sFilename$, sItem$
Dim wb As Workbook
Dim WS As Worksheet

'create folder dialog

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
sFilename = ""
With fldr
    .Title = "Please select a folder in which to create a copy of this workbook for a student"
    .AllowMultiSelect = False
    .InitialFileName = ThisWorkbook.Path
    If .Show <> -1 Then
        Call MsgBox("No folder selected. No copy created", vbOKOnly, "Warning")
        Exit Sub
    Else
        'the new copy must have a different name so this code can open it immediately.
        ' Excel will not open two documents with the same name simultaneously
        sFilename = .SelectedItems(1) & "\" & Replace(ThisWorkbook.Name, ".xlsm", " Copy.xlsm")
    End If
End With

'copy file, courtesy of Dominique

Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile ThisWorkbook.FullName, sFilename

'open newly copied document
Set wb = Workbooks.Open(FileName:=sFilename)

'change Sheet3 and 4 to the the sheets students should not see

For Each WS In wb.Sheets
    If WS.Name = "Sheet3" Or WS.Name = "Sheet4" Then
        Application.DisplayAlerts = False
        WS.Delete
        Application.DisplayAlerts = True
    End If
Next

'save and close new copy for student

Application.DisplayAlerts = False
wb.Close (True)
Application.DisplayAlerts = True

End Sub
Cyrus0
Related