CONSOLIDATE DATA FROM ALL FILES IN A FOLDER (SOLUTION)

[BrianB]

*** 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.

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

 

[bowlinbd]

This code is working great for me so far but I've been trying to modify it with little success. Is there a way to only pull rows which have information? Some of my users separate the data on their spreadsheets with empty rows but I don't care about the gaps when consolidating it into one master. Thanks.

 

[sobrien]

Thanks Brian but I need the three sheets to ramin as three seperate sheets in the designated workbook. There will be also be other sheets in the workbork that perform calculations based on the data from the three sheets - thanks in advance if you can help me

Much appreciated

 

[Ian_G]

Kudos to you Brian!

I have been trying to find answers to this dialemma for ages.

I have no knowledge of VBA or coding, I have only just found about 'ALT+F11'! However, I put this code in, changed file type to .csv and now I can save umpteen hours (per month) for writing messages of thanks to people like yourself!

I think the main difference between my use and others, is that I have used this to create a template in a specific dir and use it more as a compiler of data (I save the workbook elsewhere, replace the .csv files in said dir and run it again!)

Many thanks,
Ian

 

[Ian_G]

Hi Brian!

It was all going good until I looked at the compiled files. For some reason the date, which should read in the format of "DD/MM/YYYY", is not being picked up properly. It doesn't format it as a date and at first glance looks like a date, however, they are often the wrong date. My issue seems to be the data seems to be slightly jumbled (I get a lot of dates back, using my feb file as an example) 02/01/2012; 02/03/2012; and so on up to 02/12/2012, then it seems to return to normal layout) and then it is stored as text (I can't sort 'Oldest to Newest' only 'A to Z').

I don't suppose you could show me how to correct this?

Cheers in advance,

Ian

 

[PLongo]

I know this post is quite old but can somebody describe how the copy_destination code in this example can be modified in order to only copy or paste values only into the "master" sheet? Help is appreciated!