VBA code to copy all tabs (including macros) into new worksheet then save into desktop file

ChloeSpurge

New Member
Joined
May 5, 2021
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I'm currently using this macro to create new workbooks for each tab (xWs) in my main workbook (xWb), then the macro creates a new file with all the new workbooks and saves this file on my desktop. However, I want the VBA code contained within my main workbook to copy across to all the new workbooks created, is there some code that will automatically copy all macros from my main workbook (xWb) workbooks into all the new workbooks within my file?

VBA Code:
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim xNWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook

DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = xWb.Path & "\" & xWb.Name & " " & DateString

If Val(Application.Version) < 12 Then
    FileExtStr = ".xls": FileFormatNum = -4143
Else
    Select Case xWb.FileFormat
        Case 51:
            FileExtStr = ".xlsx": FileFormatNum = 51
        Case 52:
            If Application.ActiveWorkbook.HasVBProject Then
                FileExtStr = ".xlsm": FileFormatNum = 52
            Else
                FileExtStr = ".xlsx": FileFormatNum = 51
            End If
        Case 56:
            FileExtStr = ".xls": FileFormatNum = 56
        Case Else:
            FileExtStr = ".xlsb": FileFormatNum = 50
        End Select
End If

MkDir FolderName

For Each xWs In xWb.Worksheets
On Error GoTo NErro
    If xWs.Visible = xlSheetVisible Then
    xWs.Select
    xWs.Copy
    xFile = FolderName & "\" & xWs.Name & FileExtStr
    Set xNWb = Application.Workbooks.Item(Application.Workbooks.Count)

   
    'break all links
    Dim Link As Variant, LinkType As Variant
   
    For Each LinkType In Array(xlLinkTypeExcelLinks, xlOLELinks, xlPublishers, xlSubscribers)
        If Not IsEmpty(xNWb.LinkSources(Type:=LinkType)) Then
            For Each Link In xNWb.LinkSources(Type:=LinkType)
                xNWb.BreakLink Name:=Link, Type:=LinkType
            Next Link
        End If
    Next LinkType
    xNWb.UpdateLinks = xlUpdateLinksNever
       
    xNWb.SaveAs xFile, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    xNWb.Close False, xFile
    End If
NErro:
    xWb.Activate
Next

    MsgBox "You can find the files in " & FolderName
    Application.ScreenUpdating = True
End Sub




Thanks in advance for any help :)

Chloe
 
Last edited by a moderator:

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
927
Office Version
  1. 2010
Platform
  1. Windows
Hi,​
obviously if all the VBA procedures are within each worksheet there is nothing to code !​
When this is not the case an easy way is to create a copy of the workbook via SaveCopyAs then open the copy and remove all the unwanted …​
 

ChloeSpurge

New Member
Joined
May 5, 2021
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
Hi,

Ahh I see it works now thanks!

On more thing.. is there a way to assign a macro automatically to a button before the file is saved? Each workbook is the same but all need the same macro assigned to the same button.

Thank you
Chloe
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
927
Office Version
  1. 2010
Platform
  1. Windows
Yes you can allocate a VBA procedure to a Shape object via its property OnAction …​
 

Watch MrExcel Video

Forum statistics

Threads
1,132,890
Messages
5,655,816
Members
418,238
Latest member
LizzyG

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top