2
votes

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
1
I don't get what exactly you are trying to do. If you need links between your sheets you need to create them from scratch. If you want old links between the workbooks to persist in the new worksheets don't break them and try to .Move the sheets instead of copying them, this should actually move the links to the correct sheet too (if Microsoft didn't mess it up there). Give it a try at least.Pᴇʜ
Thanks, @Pᴇʜ for your response. I tried it using .move. still, I am getting the same output. let me explain more. For Example, I have 2 workbooks each contains 2 worksheets(for workbook 1, sheet a, sheet b & for workbook 2, sheet x & sheet y). (Sheet a) is connected to (sheet x) & (sheet b) is connected to (sheet y). I have merged these 2 workbooks using the above code. Now if I change data in (sheet a) of "original folder" it will also change data in (sheet x) of "merged workbook".Samiya Jabbar
But if I try to change data in (sheet a) of "merged workbook" I am not getting any change in data in (sheet x) of "merged workbook". I want to break all the connections of the merged workbook from the workbooks of the " original folder" so that if I change something in the workbooks of the "original folder" it won't affect the data of my "merged workbook", but what I need is, if I change data of (sheet a) within the merged workbook than data of (sheet x) should be changed.Samiya Jabbar
@Pᴇʜ: I do not think that it would work in all the cases... If, for instance, a link address involves an workbook not having each sheets already moved, a reference will not exist.FaneDuru
@FaneDuru I actually meant to close them in the end. Maybe it was unclear, my bad, will edit that.Pᴇʜ

1 Answers

2
votes

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