VBA Macro used in the Microsoft Office Excel Application

Excel Copy Multiple Workbooks into One | VBA Macro #11

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.
Subscribe
Notify of
1 Comment
Oldest
Newest Most Voted
Inline Feedbacks
View all comments
trackback

[…] Share on facebook Share on twitter Share on linkedin Have you ever had different Word Documents coming from various sources and need to combine them into one? Say for example a different team member is assigned to work on the Beginning, Middle, and End of a paper. Once each part is complete you have to open each Word Document, select all the content, then copy and navigate back to your original document to paste. Fortunately, there is a better way with VBA! With the Copy Multiple Documents into One macro you can quickly combine all these Word Documents with… Read more »

Search for Excel Macros

Recent Macros

VBA Macro used in the Microsoft Office Word Application

Word InputBox Call Macros | VBA Macro #27

More Macros More Buttons.  If you create enough macros you will begin to question if a button needs to be created for each one.  It is overwhelming when there are too many custom macro buttons to select from. This also makes navigating to run a specific macro difficult. To address this issue, we created the macro Word InputBox Call Macros! This Word macro displays an InputBox with a list of macros that can be called.  To call a specific macro just enter in the leading number and click ok. The concept of this macro is simple and helps you stay organized storing all macros within one button.

VBA Macro used in the Microsoft Office Excel Application

Excel Update Multiple Workbooks from One | VBA Macro #26

This Excel macro is the inverse of Copy Multiple Workbooks into One where separate Workbooks are being combined into one MASTER Workbook.  The Update Multiple Workbooks from One macro instead takes the current information from the MASTER Workbook and updates separate Workbooks. If you desire one source of information that can be easily distributed across multiple parties this macro is for you!

VBA Macro used in the Microsoft Office Outlook Application

Outlook Create Multiple Emails | VBA Macro #25

You just completed a task on your computer and now you need to email some impacted parties letting them know the task is complete.  Let’s say for example you have to email the client, the billing department, and your supervisor.  You could send one email including all these recipients but this is a problem if you are sending sensitive information specific to everyone involved.  Even if there isn’t sensitive information someone can use Reply All creating an email thread with everyone included. There has to be a better way…of course there is with VBA! This Outlook macro will create multiple emails based on the number that you indicate in an InputBox.  Think of this Create Multiple Emails macro as a code template that allows you generate multiple emails pertaining to different topics. Using the example above the first email can be dedicated to the client, the second email for the billing department, and the third email for your supervisor.

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