VBA Code to break links in new workbooks copied from template workbook?

the_grimace

New Member
Joined
Sep 19, 2017
Messages
5
I have a financial template with about 40 worksheets that I use to create reports for various departments and financials. I currently have a VBA script that takes each worksheet in the workbook and copies it to its own new workbook (also puts all the files into their own folder), but the new workbooks still have external links (formulas) to the template. Is there some code I could add to this script that would automatically break the links in all of the newly created workbooks? It would be great to essentially just run the script and have the reports ready to go without any external links.

Code I'm currently using below. I found this posted online and slightly modified, it works well but I just would love to have that extra functionality of breaking links too. Unfortunately I'm still learning VBA so I'm not sure what to try next.

Code:
Sub SplitWorkbook()
'Updateby20140612
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyy-mm-dd")
FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
MkDir FolderName
For Each xWs In xWb.Worksheets
    xWs.Copy
    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
    xFile = FolderName & "\" & DateString & " " & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
    Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
    Application.ActiveWorkbook.Close False
Next
MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Hi,
if you are creating reports where values remain static then you could try replacing the formulas with their values & see if that resolves your issue


Try replacing this part of your code

Code:
xFile = FolderName & "\" & DateString & " " & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
    Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
    Application.ActiveWorkbook.Close False


with this

Code:
   With Application.ActiveWorkbook
        With .Sheets(1).UsedRange
            .Value = .Value
        End With
    xFile = FolderName & "\" & DateString & " " & .Sheets(1).Name & FileExtStr
        .SaveAs xFile, FileFormat:=FileFormatNum
        .Close False
    End With

and see if helps you

Dave
 
Last edited:
Upvote 0
Thank you, Dave! This worked perfectly. I appreciate the help! :)

Hi,
if you are creating reports where values remain static then you could try replacing the formulas with their values & see if that resolves your issue


Try replacing this part of your code

Code:
xFile = FolderName & "\" & DateString & " " & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
    Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
    Application.ActiveWorkbook.Close False


with this

Code:
   With Application.ActiveWorkbook
        With .Sheets(1).UsedRange
            .Value = .Value
        End With
    xFile = FolderName & "\" & DateString & " " & .Sheets(1).Name & FileExtStr
        .SaveAs xFile, FileFormat:=FileFormatNum
        .Close False
    End With

and see if helps you

Dave
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,323
Members
452,635
Latest member
laura12345

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
Back
Top