interruzione collegamenti esterni non funziona se utilizzato direttamente dopo la creazione di un file

Question

Ho un codice che copia due fogli di lavoro da una cartella di lavoro a uno nuovo.

Poiché questi due fogli di lavoro contengono grafici in cui i dati si trovano sul foglio stesso, ma i datacell si riferiscono a un diverso foglio di lavoro, copio solo i valori, per evitare collegamenti esterni.

Tuttavia ho scoperto che esiste ancora un collegamento esterno alla cartella di lavoro originale.

1. Non so dove sia, dato che non ci sono più formule.
2. Ho pensato ai nomi e li ho cancellati, dato che c'erano molti nomi che non esistevano nemmeno nel file originale. Neanche questo ha aiutato.
3. Posso eliminare l'esterno, quando si utilizza il menu nel nastro.

E il codice riportato di seguito funziona anche quando lo utilizzo nella nuova cartella di lavoro stessa quando lo si apre e lo si esegue.

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 

Tuttavia, se voglio usare quel codice in congiunzione con la copia, non fa il trucco. L'ho salvato apposta prima di interrompere il collegamento, perché pensavo che non sarebbe stato in grado di farlo, ma non è stato d'aiuto.

Qualcuno sa perché non funziona o può indicarmi una soluzione?

Ecco il codice completo:

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 

Grazie mille in anticipo.

MODIFICA: Alla fine, brettdj ha ottenuto la soluzione, ho dovuto solo modificarlo un po 'per farlo funzionare nella mia cartella di lavoro.
Ecco il codice:

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

Se io uso questo codice i collegamenti sono passati, quando la nuova worbook si apre di nuovo.

Sono ancora perplesso sul motivo per cui la creazione originale si basa su un collegamento fantasma che esiste anche quando i due fogli copiati vengono eliminati.

codice

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