How do I remove links from a workbook linked to another

问题

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?

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

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

回答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.

来源：https://stackoverflow.com/questions/17165280/how-do-i-remove-links-from-a-workbook-linked-to-another