Break external links that do not work when used immediately after creating the file

Question

I have a code that copies two sheets from one book to a new one.

Since these two sheets contain graphs in which data is on the sheet itself, but datacalons refer to another worksheet, I copy only the values ​​to avoid external links.

However, I found out that there is still an external link to my original book.

• I do not know where this happens because the formulas no longer exist.
• I thought about the names and deleted them, as there were many names that did not even exist in the source file. It didn’t help either.
• I can delete the external one using the menu in the ribbon.

And the code below also works when I use it in the newest book, opening it and running it there.

Sub BreakLinks() Dim wb As Workbook Set wb = Application.ActiveWorkbook If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then For Each link In wb.LinkSources(xlExcelLinks) wb.BreakLink link, xlLinkTypeExcelLinks Next link End If End Sub 

However, if I want to use this code along with copying, it does not. I kept it on purpose before breaking the connection because I thought that this might not work, but it did not help.

Does anyone know why this is not working or can point me to a solution?

Here is the full code:

 Sub ACTION_Export_Capex() Dim Pfad As String Dim Dateiname As String Dim ws As Worksheet Dim wb As Workbook Pfad = "D:\@Inbox\" Dateiname = Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hhmm") & " " & "monthly Report-" & Format(DateSerial(Year(Date), Month(Date) - 1, 1), "yyyy-mm") & " Capex" & ".xlsx" 'Copy Sheets without formulas Sheets(Array("Capex_monthly", "Capex_YTD")).Copy For Each ws In Worksheets ws.UsedRange = ws.UsedRange.Value Next 'get rid of macrobuttons and hyperlinks For Each ws In Worksheets ws.Rectangles.Delete ws.Hyperlinks.Delete Next ActiveWorkbook.SaveAs Filename:=Pfad & Dateiname, FileFormat:=xlOpenXMLWorkbook 'delete external links If Not IsEmpty(ActiveWorkbook.LinkSources(xlExcelLinks)) Then For Each link In ActiveWorkbook.LinkSources(xlExcelLinks) ActiveWorkbook.BreakLink link, xlLinkTypeExcelLinks Next link End If ActiveWorkbook.Save ActiveWorkbook.Close 'go back to main menu in Cockpit Sheets("Menu").Select End Sub 

Thank you very much in advance.

EDIT: In the end, brettdj got a solution, I just had to tweak it a bit to do this in my book.
Here is the code:

 Sub ACTION_Export_Capex() Dim Pfad As String Dim Dateiname As String Dim ws As Worksheet Dim wb As Workbook Pfad = "D:\@Inbox\" Dateiname = Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hhmm") & " " & "monthly Report-" & Format(DateSerial(Year(Date), Month(Date) - 1, 1), "yyyy-mm") & " Capex" & ".xlsx" 'Copy Sheets without formulas Sheets(Array("Capex_monthly", "Capex_YTD")).Copy For Each ws In Worksheets ws.UsedRange = ws.UsedRange.Value Next 'get rid of macrobuttons and hyperlinks For Each ws In Worksheets ws.Rectangles.Delete ws.Hyperlinks.Delete Next 'get rid of external link ActiveWorkbook.ChangeLink ThisWorkbook.Name, ActiveWorkbook.Name, xlLinkTypeExcelLinks ActiveWorkbook.SaveAs Filename:=Pfad & Dateiname, FileFormat:=xlOpenXMLWorkbook ActiveWorkbook.Close Sheets("Menu").Select End Sub 

Answer 1

If I use this code, the links will disappear when the new log opens again.

I am still puzzled by why the original creation is created in the phantom link, which exists even when deleting two copied sheets.

code

 Sub Test() Dim wb As Workbook Dim wb2 As Workbook Dim Pfad As String Dim Dateiname As String Dim ws As Worksheet With Application .ScreenUpdating = False .DisplayAlerts = falser End With Pfad = "D:\@Inbox\" 'Pfad = "c:\temp\" Dateiname = Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hhmm") & " " & "monthly Report-" & Format(DateSerial(Year(Date), Month(Date) - 1, 1), "yyyy-mm") & " Capex" & ".xlsx" Set wb = ThisWorkbook Set wb2 = Workbooks.Add(1) wb.Sheets(Array("Capex_monthly", "Capex_YTD")).Copy After:=wb2.Sheets(1) wb2.Sheets(1).Delete wb2.SaveAs Filename:=Pfad & Dateiname, FileFormat:=xlOpenXMLWorkbook wb2.ChangeLink wb.Name, wb2.Name, xlLinkTypeExcelLinks wb2.Close With Application .ScreenUpdating = True .DisplayAlerts = True .Goto wb.Sheets("Menu").[a1] End With Set wb2 = Workbooks.Open(Pfad & Dateiname) End Sub