如何从链接到另一个的工作簿中删除链接

我在工作簿（评级）中有一个表单（问题），在问题表单底部有一个button，用于复制评级工作表中的工作表2（报价单），并将其粘贴到根据报价编号命名的新工作簿中然后保存。

这是代码：

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 

现在我打算删除这个新副本和Quote表之间现在存在的链接，只留下值。 我将如何做到这一点？

我发现这个代码应该删除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: 

所有我做了额外的是把这个代码下面的代码名称和复制工作表，并没有工作？

那么现在我怎样才能将这两段代码结合起来，这样一切都被复制，链接被删除了？

Answer 1

这段代码杀死了活动工作簿中的所有连接…道歉，但不记得我在哪里得到它。

  '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 

testing你的代码，这似乎工作：

  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 2

我有现有的工作簿有外部链接，我需要从工作簿中删除，然后再保存它们。

这对我工作：

 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 3

如果你不使用真正的复制和粘贴function，这也许会有所帮助。 如果您只需要单元格的值，则将其更改为

 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 

这将您的原始工作表的值复制到新的工作簿工作表，没有任何链接。

PS：不要混淆ThisWorkbook和ActiveWorkbook 。 ThisWorkbook是macros所在的工作簿（但不一定是活动工作簿）。 ActiveWorkbook是您当时看到的工作簿。