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