Consolidate Multiple Workbooks Into One Master

bowlinbd

Board Regular
Joined
Jul 18, 2008
Messages
97
I am new to using VB and macros so please forgive me. I have multiple spreadsheets, all with the same columns, that I am trying to combine into one master sheet. The column range is A through J; each workbook may have a different number of rows; all workbooks are using Sheet1.

I found the below code on http://www.mrexcel.com/forum/showthread.php?t=140187. The code works great except that I want to limit the Excel files that are being pulled in. Is there a way to manually put in only the files that I wish to consolidate? Thanks in advance.


'=========================================================
'- CONSOLIDATE DATA SHEETS
'- (ALL WORKBOOKS IN FOLDER.ALL SHEETS)
'=========================================================
'- Generic code for transferring data from
'- all worksheets from all workbooks contained in a folder
'- to a single sheet.
'- Change "Sub Transfer_data()" etc. as required.
'----------------------------------------------------------
'- Workbooks must be the only ones in the folder.
'----------------------------------------------------------
'- worksheets must be contain tables which are
'- identical to the master, headings in row 1.
'- *master sheet is remade each time*
'- run this code from the master sheet (with headings)
'- by Brian Baulsom (BrianB) January 1st.2004
'----------------------------------------------------------
Dim ToBook As String
Dim ToSheet As Worksheet
Dim NumColumns As Integer
Dim ToRow As Long
Dim FromBook As String
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim LastRow As Long
'-
'=========================================================
'- MAIN ROUTINE
'=========================================================
Sub FILES_FROM_FOLDER()
Application.Calculation = xlCalculationManual
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
ToBook = ActiveWorkbook.Name
'---------------------------
'- MASTER SHEET
'---------------------------
Set ToSheet = ActiveSheet
NumColumns = ToSheet.Range("A1").End(xlToRight).Column
ToRow = ToSheet.Range("A65536").End(xlUp).Row
'- clear master
If ToRow <> 1 Then
ToSheet.Range(ToSheet.Cells(2, 1), _
ToSheet.Cells(ToRow, NumColumns)).ClearContents
End If
ToRow = 2
'------------------------------------------
'- main loop to open each file in folder
'------------------------------------------
FromBook = Dir("*.xls")
While FromBook <> ""
If FromBook <> ToBook Then
Application.StatusBar = FromBook
Transfer_data ' subroutine below
End If
FromBook = Dir
Wend
'-- close
MsgBox ("Done.")
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
End Sub
'
'==============================================================
'- CHANGE THIS CODE TO DO WHAT YOU WANT TO THE OPENED WORKBOOK
'- HERE IT COPIES DATA FROM ALL SHEETS TO THE MASTER SHEET
'==============================================================
Private Sub Transfer_data()
Workbooks.Open FileName:=FromBook
For Each FromSheet In Workbooks(FromBook).Worksheets
LastRow = FromSheet.Range("A65536").End(xlUp).Row
'-----------------------------------------------------
'- copy/paste to master sheet
FromSheet.Range(FromSheet.Cells(2, 1), _
FromSheet.Cells(LastRow, NumColumns)).Copy _
Destination:=ToSheet.Range("A" & ToRow)
'-----------------------------------------------------
'- set next ToRow
ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
Next
Workbooks(FromBook).Close savechanges:=False
End Sub
'==== EOP ====================================================
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Hi
How do you wish to choose your files? Like all files ending with 2008 or all files beginning from bostonxxxxxxxx or just random?
Ravi
 
Upvote 0
I'd like a way to manually choose the files which files to consolidate. They're going to have different file names.
 
Upvote 0
Hi
Insert the following macro codes into a workbook and save it in the same folder where data to be consolidated is present.
Code:
Sub List_files()
Dim f As String
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Cells(2, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
End Sub
On running this macro, it lists files in the folder. Put an x mark in col B against the files you choose to consolidate.
Code:
Sub consolidate()
Dim x As Long, a As Long
Dim b As String
x = Cells(Rows.Count, 1).End(xlUp).Row
MsgBox "there are " & x - 1 & " files"
For a = 2 To x
If Cells(a, 2) = "x" Then
b = Cells(a, 1)
Workbooks.Open Filename:=Cells(1, 2) & b
y = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:J" & y).Copy
ActiveWorkbook.Close
z = Cells(Rows.Count, 1).End(xlUp).Row + 2
Range("A" & z).PasteSpecial
End If
Next a
MsgBox "Listing is complete."
End Sub
This will consolidate data from sheet1 of selected files from A to J
Ravi
 
Upvote 0
Can I amend this macro in such a way that it will only copy data from one particular sheet (let's say only "Sheet5" out of the 10 sheets in a file)? How should I do this?
 
Upvote 0
HI
replace with these codes
Code:
y = Worksheets("Sheet5").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet5").Range("A1:J" & y).Copy
Ravi
 
Upvote 0
HI
replace with these codes
Code:
y = Worksheets("Sheet5").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet5").Range("A1:J" & y).Copy
Ravi

Thanks, but my apologies: I was referring to the original macro as stated in the opening post... could you please give me guidance on how to amend the original one?
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,186
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top