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

[ChloeSpurge]

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?

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

 

[Marc L]

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]

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]

​

Yes you can allocate a VBA procedure to a Shape object via its property OnAction …​