VBA Macro used in the Microsoft Office Excel Application

Copy Multiple Excel Workbooks into One

Share on facebook
Share on twitter
Share on linkedin
This is an Excel Macro to copy separate workbooks into one MASTER workbook. Using your entries in the MASTER spreadsheet’s Details tab this macro will navigate to the folder path and identify the existing Excel workbooks. The Details tab will serve as a guide for this macro seeing if you only want specific workbooks to be combined or all that exist in the folder. If you want only specific workbooks to be copied you can list the workbook names you want them copied into the MASTER. Additionally, you can indicate if you want only the first active tab from each workbook to be copied or all of them. This Excel Macro makes it easy to pull multiple sources of information into one MASTER source on a routine basis. Create a custom button to use this macro across different workbooks impromptu. An InputBox will appear asking for a Folder Path and by default all workbooks and tabs will be copied into the active spreadsheet.
(Click Here to Download the MASTER Excel Spreadsheet utilized in these videos!)


See it in Action!

Watch this video to see this macro in action.

The Code

Here is the code behind this macro.
'Leverage & Lean "Less Clicks, More Results"
Sub CopyMultipleWorkbooksintoMASTER()
' Means variable is in use
Dim AllTabs As String '
Dim AllWorkbooks As String '
Dim Copied As String '
Dim Exist As Boolean '
Dim ExistingWorksheet As Worksheet '
Dim FolderPath As String '
Dim LastColumnLetter As String '
Dim LastColumnNumber As Integer '
Dim LastRow As Integer '
Dim MASTERWB As String '
Dim oFile As Object '
Dim oFolder As Object '
Dim oFSO As Object '
Dim OnlyFirstTab As String '
Dim Rng As Range '
Dim SeparateWB As String '
Dim TabName As String '
Dim WorkbookName As String '
Dim WorkbookNameCounter As Integer '
Dim Worksheet As Worksheet '
Dim WorksheetName As String '

MASTERWB = ActiveWorkbook.Name 'This is the MASTER Workbook everything will be copied too
  
FolderPath = Worksheets(ActiveSheet.Name).Cells(1, 2).Value
If FolderPath = "" Then 'If the FolderPath is blank input it in the box that appears
FolderPath = InputBox("The Folder Path is missing please enter it here.", "Enter Folder Path to Excel Workbooks")
End If

AllWorkbooks = Worksheets(ActiveSheet.Name).Cells(2, 2).Value 'This field determines if all Excel files will be copied
OnlyFirstTab = Worksheets(ActiveSheet.Name).Cells(3, 2).Value 'This field determines if only the first tab will be copied
AllTabs = Worksheets(ActiveSheet.Name).Cells(4, 2).Value 'This field determines if all the tabs will be copied

If AllWorkbooks = "" And OnlyFirstTab = "" And AllTabs = "" Then 'If the Details Tab is missing set Default values
AllWorkbooks = "Yes"
AllTabs = "Yes"
ElseIf OnlyFirstTab = "Yes" And AllTabs = "Yes" Then 'If Yes is indicated to both pick one
MsgBox "You can not indicate Yes to both only first tab and all tabs.  Please say Yes to only one."
Exit Sub
End If

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(FolderPath)

For Each oFile In oFolder.Files 'Loop through every File in FolderPath
If InStr(1, oFile.Type, "Microsoft Excel") <> 0 Then 'If the File Type contains the phrase Microsoft Excel
If AllWorkbooks = "Yes" Then 'Open ALL Excel Workbooks
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Workbooks.Open FolderPath & "\" & oFile.Name, UpdateLinks:=False, ReadOnly:=True
Workbooks(oFile.Name).Activate 'Open Separate Workbook
SeparateWB = ActiveWorkbook.Name
'Copy only First Tab or All Tabs?
If OnlyFirstTab = "Yes" Or AllTabs = "" Then 'Copy and Paste first spreadsheet tab
WorksheetName = ActiveSheet.Name
LastRow = Cells(Rows.Count, 1).End(xlUp).Row 'Identify Last Row on worksheet
LastColumnNumber = Cells(1, Columns.Count).End(xlToLeft).Column 'Identify Last Column Number in current row
LastColumnLetter = Replace(Cells(1, LastColumnNumber).Address(True, False), "$1", "") 'Identify Last Column Letter in current row
ActiveSheet.Range("A1:" & LastColumnLetter & LastRow).Select 'Set range and copy in seperate Workbook
Selection.Copy
Workbooks(MASTERWB).Activate
Exist = False
For Each ExistingWorksheet In ActiveWorkbook.Worksheets 'Select the appropriate tab in MASTER Workbook
If ExistingWorksheet.Name = WorksheetName Then
Exist = True
End If
Next ExistingWorksheet
If Exist = True Then 'Update existing tab
Sheets(WorksheetName).Select
ElseIf Exist = False Then 'Create new tab
Sheets.Add(After:=Sheets(Sheets.Count)).Name = WorksheetName
Sheets(WorksheetName).Select
End If
Range("A1").PasteSpecial Paste:=xlPasteValues 'Paste into the MASTER Workbook tab
Workbooks(SeparateWB).Close 'Close Separate Workbook
ElseIf AllTabs = "Yes" Then 'Copy and Paste each spreadsheet tab
For Each Worksheet In ActiveWorkbook.Worksheets 'Loop through each spreadsheet tab in Separate Workbook
WorksheetName = Worksheet.Name
LastRow = Cells(Rows.Count, 1).End(xlUp).Row 'Identify Last Row on worksheet
LastColumnNumber = Cells(1, Columns.Count).End(xlToLeft).Column 'Identify Last Column Number in current row
LastColumnLetter = Replace(Cells(1, LastColumnNumber).Address(True, False), "$1", "") 'Identify Last Column Letter in current row
ActiveSheet.Range("A1:" & LastColumnLetter & LastRow).Select 'Set range and copy in seperate Workbook
Selection.Copy
Workbooks(MASTERWB).Activate
Exist = False
For Each ExistingWorksheet In ActiveWorkbook.Worksheets 'Select the appropriate tab in MASTER Workbook
If ExistingWorksheet.Name = WorksheetName Then
Exist = True
End If
Next ExistingWorksheet
If Exist = True Then 'Update existing tab
Sheets(WorksheetName).Select
ElseIf Exist = False Then 'Create new tab
Sheets.Add(After:=Sheets(Sheets.Count)).Name = WorksheetName
Sheets(WorksheetName).Select
End If
Range("A1").PasteSpecial Paste:=xlPasteValues 'Paste into the MASTER Workbook tab
Next Worksheet
Workbooks(SeparateWB).Close 'Close Separate Workbook
End If
ElseIf AllWorkbooks <> "Yes" Then 'Open SPECIFIC Excel Workbooks
Copied = "No"
WorkbookNameCounter = 5
WorkbookName = Worksheets(ActiveSheet.Name).Cells(WorkbookNameCounter, 2).Value
Do Until WorkbookName = "" Or Copied = "Yes"
If InStr(1, oFile.Name, WorkbookName) <> 0 Then
Copied = "Yes"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Workbooks.Open FolderPath & "\" & oFile.Name, UpdateLinks:=False, ReadOnly:=True
SeparateWB = ActiveWorkbook.Name 'Open Separate Workbook
'Copy only First Tab or All Tabs?
If OnlyFirstTab = "Yes" Or AllTabs = "" Then 'Copy and Paste first spreadsheet tab
WorksheetName = ActiveSheet.Name
LastRow = Cells(Rows.Count, 1).End(xlUp).Row 'Identify Last Row on worksheet
LastColumnNumber = Cells(1, Columns.Count).End(xlToLeft).Column 'Identify Last Column Number in current row
LastColumnLetter = Replace(Cells(1, LastColumnNumber).Address(True, False), "$1", "") 'Identify Last Column Letter in current row
ActiveSheet.Range("A1:" & LastColumnLetter & LastRow).Select 'Set range and copy in seperate Workbook
Selection.Copy
Workbooks(MASTERWB).Activate
Exist = False
For Each ExistingWorksheet In ActiveWorkbook.Worksheets 'Select the appropriate tab in MASTER Workbook
If ExistingWorksheet.Name = WorksheetName Then
Exist = True
End If
Next ExistingWorksheet
If Exist = True Then 'Update existing tab
Sheets(WorksheetName).Select
ElseIf Exist = False Then 'Create new tab
Sheets.Add(After:=Sheets(Sheets.Count)).Name = WorksheetName
Sheets(WorksheetName).Select
End If
Range("A1").PasteSpecial Paste:=xlPasteValues 'Paste into the MASTER Workbook tab
Workbooks(SeparateWB).Close 'Close Separate Workbook
ElseIf AllTabs = "Yes" Then 'Copy and Paste each spreadsheet tab
For Each Worksheet In ActiveWorkbook.Worksheets 'Loop through each spreadsheet tab in Separate Workbook
WorksheetName = Worksheet.Name
LastRow = Cells(Rows.Count, 1).End(xlUp).Row 'Identify Last Row on worksheet
LastColumnNumber = Cells(1, Columns.Count).End(xlToLeft).Column 'Identify Last Column Number in current row
LastColumnLetter = Replace(Cells(1, LastColumnNumber).Address(True, False), "$1", "") 'Identify Last Column Letter in current row
ActiveSheet.Range("A1:" & LastColumnLetter & LastRow).Select 'Set range and copy in seperate Workbook
Selection.Copy
Workbooks(MASTERWB).Activate
Exist = False
For Each ExistingWorksheet In ActiveWorkbook.Worksheets 'Select the appropriate tab in MASTER Workbook
If ExistingWorksheet.Name = WorksheetName Then
Exist = True
End If
Next ExistingWorksheet
If Exist = True Then 'Update existing tab
Sheets(WorksheetName).Select
ElseIf Exist = False Then 'Create new tab
Sheets.Add(After:=Sheets(Sheets.Count)).Name = WorksheetName
Sheets(WorksheetName).Select
End If
Range("A1").PasteSpecial Paste:=xlPasteValues 'Paste into the MASTER Workbook tab
Next Worksheet
Workbooks(SeparateWB).Close 'Close Separate Workbook
End If
ElseIf InStr(1, oFile.Name, WorkbookName) = 0 Then 'If current File isn't specific workbook try the next one
WorkbookNameCounter = WorkbookNameCounter + 1
WorkbookName = Worksheets("Details").Cells(WorkbookNameCounter, 2).Value
End If
Loop
End If
End If
Next oFile

Set oFSO = Nothing
Set oFolder = Nothing
Set oFile = Nothing

End Sub
'Stay Awesome

Macro Instructions

Watch this video to get started using this macro.

Customization

There are not any code lines to customize for this macro but you can dictate how it behaves based on how you answer the following questions:

Folder Path: Where do you want to search for Excel File Types to copy and paste? (Select if the file type contains the phrase “Microsoft Excel”)

All Workbooks? Do you want to copy and paste ALL the Excel File Types found at this Folder Path?

First Tab? Only copy the first active tab that is select when opening the separate workbooks?

All Tabs? Copy all of the available tabs in each separate workbook.

Specific Workbooks? If you only want to copy specific workbooks in this Folder Path list their names starting in column B6 and continue to add additional names in column B. (Ensure that you enter the names correctly or the copy and paste won’t happen!)

If you create a custom button and run this macro in a spreadsheet that doesn’t contain a “Details” tab an InputBox will appear asking for the path to the folder you want to search.

By default All Workbooks and All Tabs will be copied and pasted into the active spreadsheet.

Insider Comments

  Subscribe  
Notify of

Search for Macros here!

Recent Macros

VBA Macro used in the Microsoft Office Outlook Application

Greeting and Goodbye

We are busy, sometimes too busy to type a friendly Greeting and Goodbye in our emails. This Outlook macro automates the entry of a Greeting “Good Morning” or “Hello” at the beginning of your emails. At the end of your email this macro automatically enters a Goodbye “Have a good night!” and “Enjoy your weekend!”. The Greeting and Goodbye macro helps you deliver better customer service and create better connections with your clients!

VBA Macro used in the Microsoft Office Outlook Application

Save Email as Outlook Email Template

It is DONE! You have drafted the perfect email and are prepared to send it. In the back of your mind you know that once you click Send it could be lost forever. Sure, you can try to copy the email to another folder or keep the email in your drafts but this isn’t sustainable in the long run. This is why Leverage & Lean created the Save Email as Outlook Template macro. With one click you can save your masterpiece and build toward your future!

VBA Macro used in the Microsoft Office Excel Application

Copy Multiple Excel Workbooks into One

This is an Excel Macro to copy separate workbooks into one MASTER workbook. The Details tab will serve as a guide for this macro seeing if you only want specific workbooks to be combined or all that exist in the folder. Additionally, you can indicate if you want only the first tab from each workbook to be copied or all of them. This Excel Macro makes it easy to pull multiple sources of information into one MASTER source on a routine basis.

First time using VBA?

The Developer Tab is an additional section of the ribbon when activated allows you access to Visual Basic in Applications like Excel, Outlook, Word.
Setup Now
Once the Developer Tab is available you will have the capability to update your security to allow Macros to run in the current application.
Setup Now
A sub of code is a collection of objects and variables. For the code to successfully run a library of references needs to be set.
Setup Now

Looking for more?

Subscribe as an Insider to receive additional rights.

Contact Us

Looking to improve your computer processes?
Leverage & Lean is here to help!

Copyright © 2019 Leverage & Lean – Uptown Style WordPress theme by GoDaddy