CONSOLIDATE DATA FROM ALL FILES IN A FOLDER (SOLUTION)

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
*** PLEASE NOTE : I DO NOT REPLY TO ANY MESSAGES HERE. PLEASE MAKE A SEPARATE MESSAGE OR KEEP TO THE ORIGINAL ONE *****
This is in response to a FAQ. Previously published in response to a message question, I am posting this code because some users have had a problem with the Copy/Paste line. I have corrected this by including the worksheet name in each cells() definition.
Code:
'=========================================================
'- 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

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Thanks for such a great job, but please I do not have any basic knowledge of programming.

Just as you said, The first file name is Payroll.csv, Next is Vacation.csv, Next is Contrator.csv etc

I will like to copy or append this xls file to a one Xls file called Master.csv every day.

------------------------------------------------------------------------
Once I get the step above running, I will like to have this file deleted every morning so that the current day will be copied over.

Please do be as simple as possible to help me, the code you send now, were will i copy it over? on the master file (excel macro)?
 
Upvote 0
How would I modify this code to copy the entire sheets of the other files to a new workbook as opposed to just the ranges?

Thanks,
DaVuLf
 
Upvote 0
Am I on the right track?

Code:
Private Sub Transfer_data() 
    Workbooks.Open FileName:=FromBook 
    For Each FromSheet In Workbooks(FromBook).Worksheets 
        LastRow = FromSheet.Range("A65536").End(xlUp).Row 
Dim First As Boolean
    First = True
            If First Then
                FromSheet.Copy
                Set wb = ActiveWorkbook
                First = False
            Else
                FromSheet.Copy After:=wb.Worksheets(wb.Worksheets.Count)
            End If
Next 
    Workbooks(FromBook).Close savechanges:=False 
End Sub
 
Upvote 0
Code:
'=====================================================
'- ALTERNATIVE VERSION OF THE SUBROUTINE : 
'- HERE IT COPIES ALL WORKSHEETS TO THE MASTER WORKBOOK
'=====================================================
Private Sub Transfer_data()
    Workbooks.Open FileName:=FromBook
    For Each FromSheet In Workbooks(FromBook).Worksheets
        S = Workbooks(ToBook).Worksheets.Count
        FromSheet.Copy AFTER:=Workbooks(ToBook).Worksheets(S)
    Next
    Workbooks(FromBook).Close savechanges:=False
End Sub
'==== EOP ====================================================
 
Upvote 0
A couple of questions about the information above:

1. I presume that I eneter this into a new worksheet within a workbook that conatins the different worksheet?
2. How do I enter this programming into the worksheet?

Thank you for any assistance.

Xerxers
 
Upvote 0
Use Alt+F11 key to get the macro editor and paste into a module there.

You will need to do some reading about Excel macros.
 
Upvote 0
Brian,

thanks for your response.

In the end I have done everything manually as there were just too many other complicating factors i.e. each row contained different information and in each sheet the colum headings were different.

However I will read more up on macros and someday take the plunge.

Xerxers
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,172
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