3
\$\begingroup\$

My aim is to merge all workbooks having multiple sheets from any specified folder to one workbook of multiple sheets. The problem is I don’t want external links to be maintained, If I use "breaklink" it will break all links(external links) b/w sheets of all workbooks. what I exactly I need is, After merging all sheets of workbooks in one workbook, I need links b/w these merged sheets.

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
```
\$\endgroup\$
4
  • 3
    \$\begingroup\$ "I need links b/w these merged sheets" - what does "b/w" mean? To me, that means "black and white", as in photography or TV. It's unclear - does this code actually do what you want it to do, or do you need help resolving a bug? If it's functional, what kind of review are you looking for? At a minimum, I'd strongly recommend some indention to make the nesting levels more obvious. \$\endgroup\$
    – FreeMan
    Nov 13 '20 at 12:03
  • \$\begingroup\$ The links between sheets within a single workbook are formatted as <sheetname>!<range>. When you merge/move/copy those sheets into a different workbook, the original workbook name is added [<workbook>]<sheetname>!<range>. So my recommendation is after you merge a set of sheets from a workbook, perform a find and replace on any formulas to remove the string between (and including) the square brackets. \$\endgroup\$
    – PeterT
    Nov 16 '20 at 17:53
  • \$\begingroup\$ Thanks, @FreeMan for your recommendation, b/w means between. I have got the answer now. \$\endgroup\$ Nov 18 '20 at 8:11
  • \$\begingroup\$ Thanks, @Peter T for your response. yes, hope this strategy will be worked fine. But I have got a simple solution, I am sharing here to help others. \$\endgroup\$ Nov 18 '20 at 8:16
4
\$\begingroup\$

Here are a couple of pointers:

  • FolderPath should be a constant because it's value will never change
  • Using a wildcard Filter with the path will ensure that you open the correct files
  • Although ActiveWorkbook does the job, it is best to get in the habit of using qualified references
  • Workbook.Worksheets returns a Worksheets Collection (not to be confused with a normal VBA Collection)
  • Worksheets can be used to perform group operations on all of it's Worksheets at one time
  • Download RubberDuck. Among its many great features is Code Indentation. It will save you a ton of time reformatting and show you unclosed code blocks

Sub merge()
    Const FolderPath As String = "C:\Users\Samiya jabbar\Desktop\test"
    Const Pattern As String = "*.xl*"
    
    Dim Filename As String

    Dim Sheet As Worksheet

    Application.ScreenUpdating = False

    Filename = Dir(FolderPath & Pattern)

    Do While Filename <> ""

        Workbooks.Open(Filename:=FolderPath & Filename, ReadOnly:=True).Worksheets.Move After:=ThisWorkbook.Sheets(1)

        Filename = Dir()

    Loop

    Application.ScreenUpdating = True

End Sub
\$\endgroup\$
0
\$\begingroup\$

First you have to open all files that are involved before you start moving. Now move sheets (don't copy them), instead of .copy, use .move . Save your merged workbook.

REVISED 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.move After:=ThisWorkbook.Sheets(1)

Next Sheet

Filename = Dir()

Loop

Application.ScreenUpdating = True

End Sub
```
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.