vba code to break links in new workbook

Reddog94

Board Regular
Joined
Dec 20, 2011
Messages
52
I have code that copies any worksheet that begins with "CC", moves it to a new workbook and saves it to my desktop. I need to add more code that will break links in the newly created workbooks, but have only been able to figure out the code to break links in the active workbook, which is the template that holds the code. Can anyone tell me how to break links in the new workbooks?

Here is the code I know to break links in the active workbook:

Sub break_links()
Dim Links As Variant
Links = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)

For i = 1 To UBound(Links)

ActiveWorkbook.BreakLink _
Name:=Links(i), _
Type:=xlLinkTypeExcelLinks
Next i

End Sub


Here is the code that copies the worksheets:

Sub Copy_Save ()

Dim wb As Workbook
Dim NewBook As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wb = ActiveWorkbook

For Each ws In wb.Worksheets
If UCase(Left(ws.Name, 2)) = "CC" Then
Set NewBook = Workbooks.Add
With NewBook
.Title = ws.Name
.Subject = "Sales"
ws.Copy After:=NewBook.Worksheets("Sheet3")
For Each ws2 In NewBook.Worksheets
If ws2.Name <> ws.Name Then
ws2.Delete
End If
Next
.SaveAs Filename:="C:\Users\Reddog94\Desktop\" & ws.Name
.Close
End With
End If
Next

wb.Activate

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

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Trevor G

Well-known Member
Joined
Jul 17, 2008
Messages
6,501
Have you tried to call the other routine that breaks the link before you close the workbook.
 

Firefly2012

Well-known Member
Joined
Dec 28, 2011
Messages
3,638
If you amend your break links code to:

Code:
Sub break_links(ByRef wb As Workbook)
Dim Links As Variant
On Error Resume Next
Links = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
On Error Goto 0
If Not Isempty(Links) Then

For i = 1 To UBound(Links)

wb.BreakLink _
Name:=Links(i), _
Type:=xlLinkTypeExcelLinks
Next i

End If
End Sub

Andthen amend your Copy_Save code in the following way:

Code:
'''Old code first
'.SaveAs Filename:="C:\Users\Reddog94\Desktop\" & ws.Name 
'.Close
 
'New code:
 
.SaveAs Filename:="C:\Users\Reddog94\Desktop\" & ws.Name 
Call break_links(NewBook)
.Close SaveChanges:=True
 

Reddog94

Board Regular
Joined
Dec 20, 2011
Messages
52
It worked - had to put the Call before .SaveAs, but once I did that it worked perfectly.

Thank you very much!
 

Watch MrExcel Video

Forum statistics

Threads
1,099,733
Messages
5,470,435
Members
406,699
Latest member
perfectioncts

This Week's Hot Topics

Top