CODEWITHSUNDEEP
vbaexcel
Part_Time_Nerd
Part_Time_Nerd

Reputation: 1014

Using VBA to remove the reference to a file name in formulas

I am trying to copy a series of worksheets from an Excel workbook and paste them into a new workbook. The issue that I am having is that when I copy worksheets into a new workbook the formulas still a reference to the old workbook in the formulas. I tried to get the name of the workbook and replace it with a null character but I believe my code is referencing the new workbook and not the old one. I tried a function as well as 'ThisWorkbook' as well as 'ActiveWorkbook' but none seem to be working.

Here is the function....

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

Here is the full code....

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

Upvotes: 1

Views: 2508

Answers (2)

Part_Time_Nerd
Part_Time_Nerd

Reputation: 1014

I was able to get the intended results with the following code.

  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

Upvotes: 1

CLR
CLR

Reputation: 12289

Could you not just use the BreakLinks method?

'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

Upvotes: 0

Related Questions