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 ====================================================
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 ====================================================