How do I remove links from a workbook linked to another - vba

Question

I have a sheet(Questions) in a workbook(Rating) that has a button at the bottom of the Questions sheet that copies sheet 2(quote) from the Rating workbook and pastes it in a new workbook that is named according to the quote number and then saved.
Here is that code:
Sub GetQuote()
Range("AK548").Select
Selection.Copy
Range("AK549").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim Output As Workbook
Dim FileName As String
Set Output = Workbooks.Add
FileName = ThisWorkbook.Path & "\" & ThisWorkbook.Worksheets("Questions").Range("AK545").Value & ".xls"
Output.SaveAs FileName
Application.DisplayAlerts = False
Output.Worksheets("Sheet1").Delete
ThisWorkbook.Worksheets(2).Copy Before:=Output.Worksheets("Sheet2")
Output.Worksheets(1).Name = "Sheet1"
Application.DisplayAlerts = True
Output.Protect Password:="12345"
Output.Save
End Sub
Now I intend on removing the links that now exsist between this new copy and the Quote sheet and only leave the values. How would I do this?
I have found this code that should delete the links that exsist:
Dim Cell As Range, FirstAddress As String, Temp As String
'delete all links from selected cells
Application.ScreenUpdating = False
With Selection
Set Cell = .Find("=*!", LookIn:=xlFormulas, searchorder:=xlByRows, _
LookAt:=xlPart, MatchCase:=True)
On Error GoTo Finish
FirstAddress = Cell.Address
Do
Temp = Cell
Cell.ClearContents
Cell = Temp
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
End With
Finish:
All I have done extra is put this code in below the code that Names and copies the sheet and that did not work?
So now how would I combine these two pieces of code so that everything gets copied and the links removed?

Answer 1

I had existing workbooks that had external links that i needed to remove from the workbooks and then re save them.
This worked for me:
Sub BreakExternalLinks()
'PURPOSE: Breaks all external links that would show up in Excel's "Edit Links" Dialog Box
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
Dim ExternalLinksArray As Variant
Dim wb As Workbook
Dim x As Long
Set wb = ActiveWorkbook
'Create an Array of all External Links stored in Workbook
ExternalLinksArray = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
'if the array is not empty the loop Through each External Link in ActiveWorkbook and Break it
If IsEmpty(ExternalLinksArray) = False then
For x = 1 To UBound(ExternalLinksArray )
wb.BreakLink Name:=ExternalLinksArray (x), Type:=xlLinkTypeExcelLinks
Next x
end if
End Sub

Answer 2

This piece of code kills all connections in the active workbook... apologies, but can't remember where I got it.
'Kill Connections
If ActiveWorkbook.Connections.Count > 0 Then
For i = 1 To ActiveWorkbook.Connections.Count
ActiveWorkbook.Connections.Item(1).Delete
Next i
Else
End If
Tested with your code, this seems to work:
Dim Output As Workbook
Dim FileName As String
Set Output = Workbooks.Add
FileName = ThisWorkbook.Path & "\" & ThisWorkbook.Worksheets("Questions").Range("A1").Value & ".xls"
Output.SaveAs FileName
Application.DisplayAlerts = False
Output.Worksheets("Sheet1").Delete
ThisWorkbook.Worksheets(2).Copy Before:=Output.Worksheets("Sheet2")
Output.Worksheets(1).Name = "Sheet1"
Output.Worksheets(1).Select
If ActiveWorkbook.Connections.Count > 0 Then
For i = 1 To ActiveWorkbook.Connections.Count
ActiveWorkbook.Connections.Item(1).Delete
Next i
Else
End If
Application.DisplayAlerts = True
Output.Protect Password:="12345"
Output.Save

Answer 3

Perhaps it would help, if you don't use the actual copy & paste functions. If you only need the values of the cells, then change your macro to
Sub GetQuote()
Range("AK548").Select
Selection.Copy
Range("AK549").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim Output As Workbook
Dim FileName As String
Set Output = Workbooks.Add
FileName = ThisWorkbook.Path & "\" & ThisWorkbook.Worksheets("Questions").Range("AK545").Value & ".xls"
Output.SaveAs FileName
Application.DisplayAlerts = False
Dim v, r As Long, c As Long
With ThisWorkbook.Worksheets(2)
r = .Cells.SpecialCells(xlCellTypeLastCell).Row
c = .Cells.SpecialCells(xlCellTypeLastCell).Column
v = .Range(.Cells(1, 1), .Cells(r, c))
End With
With Output.Worksheets(1)
.Range(.Cells(1, 1), .Cells(r, c)) = v
End With
Application.DisplayAlerts = True
Output.Protect Password:="12345"
Output.Save
End Sub
This copies the values of your origin sheet to the new workbook sheet, without any links.
P.S.: Don't mix up ThisWorkbook and ActiveWorkbook. ThisWorkbook is the workbook where the macro is located (, but not necessarily the active workbook). ActiveWorkbook is the workbook, you see at that time.