使用VBA删除公式中对文件名的引用

时间:2017-01-26 15:18:13

标签: excel vba excel-vba

我正在尝试从Excel工作簿中复制一系列工作表并将其粘贴到新工作簿中。我遇到的问题是,当我将工作表复制到新工作簿时,公式仍然是对公式中旧工作簿的引用。我试图获取工作簿的名称并将其替换为空字符,但我相信我的代码引用了新工作簿而不是旧工作簿。我尝试了一个功能以及“ThisWorkbook”#39;以及' ActiveWorkbook'但似乎都没有工作。

这是函数....

Function MyName() As String
    MyName = ThisWorkbook.Name
End Function

这是完整的代码......

Sub CopyToNewWorkbook()

  Dim ws As Worksheet
  Dim i As Integer
  Dim wbCurrent As Workbook
  Dim wbName As Variant
  Dim wbNew As Workbook

  'wbName = ActiveWorkbook.Name
  'wbName = ThisWorkbook.Name
  Set wbCurrent = ActiveWorkbook
  Set wbNew = Workbooks.Add

  For Each ws In wbCurrent.Sheets   
    Do While wbNew.Sheets.Count <= (wbCurrent.Sheets.Count - 3)
      For i = 3 To wbCurrent.Sheets.Count
        wbCurrent.Sheets(i).Copy after:=wbNew.Sheets(wbNew.Sheets.Count)            
      Next i
    Loop            
  Next ws

  wbNew.Activate
  Sheets("Sheet1").Select
  ActiveWindow.SelectedSheets.Delete

  Cells.Replace What:=MyName, Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

End Sub

2 个答案:

答案 0 :(得分:1)

我能够通过以下代码获得预期的结果。

  Sub CopyToNewWorkbook()      

  Dim ws As Worksheet
  Dim i As Integer
  Dim wbCurrent As Workbook
  Dim wbName As Variant
  Dim wbNew As Workbook

  Call MyName
    wbName = MyName

  Set wbCurrent = ActiveWorkbook
  Set wbNew = Workbooks.Add

  For Each ws In wbCurrent.Sheets   
    ws.Visible = xlSheetVisible
    Do While wbNew.Sheets.Count <= (wbCurrent.Sheets.Count - 3)
      For i = 3 To wbCurrent.Sheets.Count
        wbCurrent.Sheets(i).Copy after:=wbNew.Sheets(wbNew.Sheets.Count)            
      Next i
    Loop            
  Next ws

  wbNew.Activate
    Sheets("Sheet1").Select
      ActiveWindow.SelectedSheets.Delete

  Cells.Replace What:=MyName, Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

  Cells.Replace What:="'[" & wbName & "]", Replacement:="'", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
        False, SearchFormat:=False, ReplaceFormat:=False
End Sub

答案 1 :(得分:0)

你能不能只使用BreakLinks方法?

'Get all links
  ExternalLinks = wbNew.LinkSources(Type:=xlLinkTypeExcelLinks)

'Break each link
 For x = 1 To UBound(ExternalLinks)
   wbNew.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
 Next x