MACRO TO COMBINE DATA FROM MULTIPLE EXCEL WORKSHEETS INTO ONE EXCEL FILE

[Twenny02]

Hi,

I have multiple Excel workbook files stored in the same folder location, each workbook file has one worksheet with a table of data. Every table in each of the workbooks is in a consistent format (so the columns are in the same order with the same data type).

Is anyone able to advise on a macro that can combine the data from all of the individual worksheet tables into one consolidated Excel file please?

I suppose the key knowledge gaps for me are ensuring the macro takes the data from all of the files in the folder, and is able to paste the data in the next blank row in the consolidated Excel workbook. This includes:
*the macro copies data from all of the files in the folder location, including any new files added since the macro was written.
*the macro does not fail if files have been removed from the folder location since the macro was written.
*the macro is able to detect the next blank row to paste the data into the consolidated Excel workbook (as the number of rows in the individual tables will change).

Details


The full path to the folder holding the workbooks in question is:
C:\Users\bkljsx\Documents\Schedule\WeeklyUpdates\WeeklyExtracts

This folder only contains Excel workbooks and no other type of file.

All the workbooks in this folder will be imported by this procedure.

There is only one sheet in each workbook (all sheets are called 'Task_Table1').

There are headings for the tables in each workbook, but I do not want these copied into the consolidated workbook.

Due to the requirement to omit the headings, the data for each table begins in cell A2.

Any guidance much appreciated!

Thanks

Jon

 

[SkipVought]

Hi,

Thank you for the additional information.

In addition, what sheet is to receive the data?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[randy700]

I got this code somewhere on this website long ago.
Can't remember exactly where, but I think SkipVought provided it.

Sub ImportWorkbooks()
Dim FilesToOpen
    Dim x As Integer

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.*), *.*", _
      MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    While x <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(x)
        Sheets().Move After:=ThisWorkbook.Sheets _
          (ThisWorkbook.Sheets.Count)
        x = x + 1
    Wend
    
    Debug.Print Worksheets.Count
    
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler

End Sub

Sub CombineWorksheets()
Dim J As Integer

    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add ' add a sheet in first place
    Sheets(1).Name = "Combined"

    ' copy headings
    Sheets(3).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")

    ' work through sheets
    For J = 3 To Sheets.Count ' from sheet 2 to last sheet
        Sheets(J).Activate ' make the sheet active
        Range("A1:A100").Select
        ' Selection.CurrentRegion.Select ' select all cells in this sheets

        ' select all lines except title
        ' Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

        ' copy cells selected in the new sheet on last line
        Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
    Next

End Sub

Randy

 

[SkipVought]

Sorry, not my code AFAIK.

If the OP answers my additional question, I have a solution to post.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[SkipVought]

Well I'll just go ahead and post this solution that assumes the destination sheet is the first sheet...

Sub ImportData()
'SkipVought 2016 May 09
    Dim oFSO As Object, oFile As Object, sFolderspec As String
    Dim ws As Worksheet, lRow As Long
    
    sFolderspec = "C:\Users\bkljsx\Documents\Schedule\WeeklyUpdates\WeeklyExtracts"
    
    Set ws = ThisWorkbook.Workbooks([b]"ConsolWeeklyExtract"[/b])
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    For Each oFile In oFSO.GetFolder(sFolderspec).Files
        With Workbooks.Open(oFile)
            With .Worksheets(1)
                Intersect(Range(.Rows(2), .Rows(UsedRange.Rows.Count)), .UsedRange).Copy
                
                lRow = ws.Cells(1, 1).CurrentRegion.Rows.Count + 1
                ws.Cells(lRow, 1).PasteSpecial xlPasteValues
            End With
            .Close
        End With
    Next
End Sub

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Twenny02]

Hi,

Thank you for your replies.

The sheet to receive the data is 'ConsolWeeklyExtract'

Jon

 

[SkipVought]

I modified the code that I previously posted, adding your sheet name.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Twenny02]

Thanks Skip,

Will give this a try.

 

[SkipVought]

This code assumes that it is in your target workbook in a Module.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Twenny02]

Cheers Skip, this went well. Only minor config I needed to make was to change .Workbooks to .Worksheet.

Thanks for your help!

 

[Andrzejek]

Twenny02,
It is customary at TT to award stars for help received.
The stars also mark the post(s) that were helpful so others who search for an answer can find it easily.

Use the link "[blue]Great Post[/blue]" to do so.

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.