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

Some videos you may like

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

UKN

New Member
Joined
May 30, 2005
Messages
14
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)?
 

davulf

Active Member
Joined
Jul 4, 2005
Messages
273
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
 

davulf

Active Member
Joined
Jul 4, 2005
Messages
273
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
 

davulf

Active Member
Joined
Jul 4, 2005
Messages
273

ADVERTISEMENT

Is this even close to being right?...
 

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
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 ====================================================
 

sinsin

New Member
Joined
Jun 13, 2006
Messages
4

ADVERTISEMENT

:p Many Thanks This will be a great start :p
 

xerxers

Board Regular
Joined
Nov 30, 2005
Messages
140
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
 

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
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.
 

xerxers

Board Regular
Joined
Nov 30, 2005
Messages
140
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,861
Messages
5,627,314
Members
416,239
Latest member
Counselor85027

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
Top