Instead of external links we need internal links b/w merged workbooks, using VBA

user_14624991 0
Viewed 136

My aim is to merge all workbooks having multiple sheets from any specified folder to one workbook of multiple sheets. (I have attached code below) The problem is I don’t want external links to be maintained, I tried to break these links using Macro, it’s also working. (just using breaklink command, attached below)

But what I exactly want is, After merging all workbooks in one workbook, instead of external links I need links b/w these merged sheets, so is there any strategy that I can use?

Code for merge all workbooks into one workbook

Sub merge()
    Dim FolderPath As String    
    Dim Filename As String    
    Dim Sheet As Worksheet    
    
    Application.ScreenUpdating = False 
   
    FolderPath = "C:\Users\Samiya jabbar\Desktop\test\"    
    Filename = Dir(FolderPath)    
    
    Do While Filename <> ""
        Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True

        For Each Sheet In ActiveWorkbook.Sheets    
            Sheet.Copy After:=ThisWorkbook.Sheets(1)    
        Next Sheet  
    
        Workbooks(Filename).Close
        Filename = Dir()
    Loop
    
    Application.ScreenUpdating = True
End Sub

Break link

Set wb = Application.ActiveWorkbook

If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
    For Each link In wb.LinkSources(xlExcelLinks)
        wb.BreakLink link, xlLinkTypeExcelLinks
    Next link
vba excel
1 Answers

In order to move all formula references correctly:

  1. Open all files that are involved before you start moving.
  2. Move your sheets (don't copy them).
  3. After all movements are done: Close the files you don't need anymore (don't save changes if you want to keep the original files as before moving sheets).
  4. Save your merged workbook.

Here is a proof of concept:

First we create 3 files with 2 workbooks each

Public Sub CreateTestWorkbooks()
    Const Path As String = "C:\Temp\MoveTest\"
    Const nWb As Long = 3 'amount of workbooks to create
    Const nWs As Long = 2 'amount of worksheets in each workbook
    
    Dim NewWb() As Workbook
    ReDim NewWb(1 To nWb) As Workbook
    
    Dim iWs As Long
    
    Application.ScreenUpdating = False
    
    'create workbooks
    Dim iWb As Long
    For iWb = 1 To nWb
        Set NewWb(iWb) = Application.Workbooks.Add
        For iWs = 1 To nWs - 1
            NewWb(iWb).Worksheets.Add After:=NewWb(iWb).Sheets(NewWb(iWb).Sheets.Count)
        Next iWs
        NewWb(iWb).SaveAs Filename:=Path & "File" & iWb & ".xlsx"
    Next iWb
    
    'write formulas
    Dim iFormula As Long
    For iWb = 1 To nWb
        For iWs = 1 To nWs
            NewWb(iWb).Worksheets(iWs).Range("A1").Value = "File" & iWb & ".xlsx " & "Sheet" & iWs
            For iFormula = 1 To nWb
                NewWb(iWb).Worksheets(iWs).Cells(iFormula, "B").Formula = "=[File" & iFormula & ".xlsx]Sheet" & iWs & "!$A$1"
            Next iFormula
        Next iWs
    Next iWb
    
    'save and close workbooks
    For iWb = 1 To nWb
        NewWb(iWb).Close SaveChanges:=True
    Next iWb
    
    Application.ScreenUpdating = True
    MsgBox "All " & nWb & " files were created.", vbInformation
End Sub

Then we consolidate them

Public Sub ConsolidateWorkbooks()
    Const Path As String = "C:\Temp\MoveTest\"
    
    Dim OpenedWorkbooks As Collection
    Set OpenedWorkbooks = New Collection
    
    Application.ScreenUpdating = False
    
    'loop through files and open them all
    Dim File As String
    File = Dir(Path & "*.xlsx")
    Do While File <> vbNullString
        OpenedWorkbooks.Add Application.Workbooks.Open(Filename:=Path & File, UpdateLinks:=True)
        File = Dir()
    Loop
    
    'create a new workbook to consolidate all worksheets
    Dim ConsolidateWb As Workbook
    Set ConsolidateWb = Application.Workbooks.Add
    
    'consolidate
    Dim wb As Workbook
    For Each wb In OpenedWorkbooks
        Dim sh As Variant
        For Each sh In wb.Sheets
            sh.Move After:=ConsolidateWb.Sheets(ConsolidateWb.Sheets.Count)
            
            'this changes the constant in A1 of each sheet to make it
            'visible that formulas are now pointing to the new file (no formula changes are made here)
            With ConsolidateWb.Sheets(ConsolidateWb.Sheets.Count)
                .Range("A1").Value = "Consolidated.xlsx " & .Name
            End With
        Next sh
    Next wb
    
    Application.ScreenUpdating = True
    
    ConsolidateWb.SaveAs Filename:=Path & "Consolidated.xlsx"
End Sub
user_32196130
Related