Looking for VBA code to split worksheets, break links, and save as a new workbook

[marigold322]

Hi there,

I am working on creating Excel documents that function as multiple forms going to different people. So the idea is the first sheet in the workbook is the 'Mastersheet' with all of the data arranged in a table. Subsequent sheets contain the forms. Each form contains formulas that reference the mastersheet and fill in relevant information into respective fields using VLOOKUP. In addition to filling in information from the mastersheet, there are some formulas that calculate values as part of the fillable form, if that makes sense. (The individuals would fill in the forms and then our formulas will calculate any relevant values)

Each sheet has to be sent out to individuals, and we don't want the information from the mastersheet to be updated if it was to be changed, but we still need some of the formulas to carry over (the ones that calculate values). so the old process was to save a copy of each individual sheet and then either break links or copy formulas/paste values. Right now, I am struggling with the VLOOKUP formulas as I would like them to just show the values if that makes sense.

What I am struggling with is finding a VBA code that will make a copy of every sheet (except for the mastersheet), break all the links, and then save as the worksheet name in the original file location. I found code that will split sheets (below) and a couple examples of how to break links, but have not been able to successfully combine the two (I want the sheets to split FIRST, so the original document will still contain links.

I have been using a slightly modified code below that I got from Sumit Bansal from TrumpExcel.com. This works pretty well, however the If ws.name <> "MASTERSHEET" seems to be ineffective as running the code results in every sheet being copied and saved, including the mastersheet.

If anyone has any guidance on how I can revise this code in order to first split the sheets after the mastersheet, then to remove/break all links (I think this is my best bet because i do still need some formulas however these formulas only reference cells within the sheet itself), and finally to save in the original file location renamed as the sheet name. Whew, that was a mouthful...

Sub SplitEachWorksheet()
Dim FPath As String
FPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
    If ws.Name <> "MASTERSHEET" Then
        ws.Copy
        Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
        Application.ActiveWorkbook.Close False
    End If

Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[John_w]

Try this macro:

Public Sub Save_Each_Sheet_As_Workbook()

    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False  'suppress warning if .xlsx file already exists - file is replaced
    
    With ActiveWorkbook
        For Each ws In .Worksheets
            If StrComp(ws.Name, "Mastersheet", vbTextCompare) <> 0 Then
                ws.Copy
                ActiveWorkbook.SaveAs .Path & "\" & ws.Name & ".xlsx"
                ActiveWorkbook.BreakLink Name:=.FullName, Type:=xlExcelLinks
                ActiveWorkbook.Close SaveChanges:=True
            End If
        Next
    End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Done"
    
End Sub

 

[marigold322]

Try this macro:

Public Sub Save_Each_Sheet_As_Workbook()

    Dim ws As Worksheet
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False  'suppress warning if .xlsx file already exists - file is replaced
   
    With ActiveWorkbook
        For Each ws In .Worksheets
            If StrComp(ws.Name, "Mastersheet", vbTextCompare) <> 0 Then
                ws.Copy
                ActiveWorkbook.SaveAs .Path & "\" & ws.Name & ".xlsx"
                ActiveWorkbook.BreakLink Name:=.FullName, Type:=xlExcelLinks
                ActiveWorkbook.Close SaveChanges:=True
            End If
        Next
    End With
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    MsgBox "Done"
   
End Sub

Well Mr. John_w, it seems that my coworkers and I would be eternally grateful for your help. I just tried this and it worked like a charm and I cannot lie it brought a tear to my eye... Thank you thank you thank you!!!! I hope you have yourself a wonderful weekend sir. THANK YOU!