VBA Code

Joined
Nov 21, 2016
Messages
32
Hi All,

I have 58 workbooks that I need to be put into one table on a separate workbook.

All the workbooks have two sections i need to copy: A11:Y24/25 and A28:Y41/42

As they are all have the same headers, I would like to put them all into one table automatically

Could any one help me with this please?

Thank you!
 

Some videos you may like

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.

FatBoyClam

Board Regular
Joined
Jan 8, 2020
Messages
183
Office Version
365
Platform
Windows
Are all the workbooks in the same folder? are there any other files in the same folder?

If not, how do you identify the workbooks to read from?

What worksheet in the workbooks are the two source ranges on?

When you say "table" are you targetting the data into an Excel Structured table (as created by going to Insert>Table)?

If so, does this table already exist, or does it need to be created by the macro?

if not, would you consider using a structured table (they come with a lot of advantages)?
 
Joined
Nov 21, 2016
Messages
32
Hi FatboyClam,

All the workbooks are in one folder, each workbook has a unique id number i.e 000001_Summary, 000002_Summary, Ect

The two ranges are on the opening sheet of each workbook.

Yes I would like to send them all to a single Excel structured table if possible.

The table already exists called TBLdata with the Headers from A1:Y1
 

FatBoyClam

Board Regular
Joined
Jan 8, 2020
Messages
183
Office Version
365
Platform
Windows
Excellent.

I still need/want to know what the name of the sheet the source ranges are found on, unless the sheets are not named in a consistent/predictable fashion. Also, need to know the sheet in the target workbook that the table is on (I'm going to call it "Data" in the code for now)

I'm going to assume it's called "Sheet1" for the time being.

I'm also going to assume that at the end of the macro you want the table "TBLdata" to contain only that which has been extracted from the other workbooks, so I'll delete any existing data in the table at the start of the routine.

I'm also assuming that there are no files in the source folder other than the 58 you want to extract the data from, and that none of the files have passwords to open or modify.

First, in the Visual Basic Editor, you'll need to add a reference to the Windows Script Host Object Model. Click on the Tools menu and select References;

1581084831689.png


Scroll down the list to find Windows Script Host Object Model (near the bottom) and tick the box next to it, then click OK.

This allows us to us a FileSystemObject to get the files from a folder one by one.

When you say the data is in A11:Y24/25 I'm assuming you mean that rows 11 to 24 will always have data, but 25 might or might not.

VBA Code:
Sub CollateAllWorkbooksInAFolder()

Dim strFolderPath As String
Dim fso As New FileSystemObject, fFolder As Folder, fFile As File
Dim wb As Workbook, sht As Worksheet, rng As Range
Dim tbl As ListObject

strFolderPath = "C:\test\" 'Change this to the folder your files are in

For Each sht In ThisWorkbook.Worksheets
    For Each tbl In sht.ListObjects
        If tbl.Name = "TBLdata" Then Exit For
    Next
    If Not tbl Is Nothing Then
        If tbl.Name = "TBLdata" Then Exit For
    End If
Next

If tbl Is Nothing Then
    MsgBox "No table called TBLdata found in this workbook!"
    Exit Sub
End If

If tbl.Name <> "TBLdata" Then
    MsgBox "No table called TBLdata found in this workbook!"
    Exit Sub
End If

If tbl.InsertRowRange Is Nothing Then
    tbl.DataBodyRange.Delete
End If

Set fFolder = fso.GetFolder(strFolderPath)
For Each fFile In fFolder.Files

    Set wb = Workbooks.Open(fFile.Path, False, True)
    
    Set sht = wb.Sheets("Sheet1")
    
    Set rng = sht.Range("A11:Y25")
    
    If rng.Cells(rng.Rows.Count, 1).Value = "" Then
        Set rng = rng.Resize(rng.Rows.Count - 1, rng.Columns.Count)
    End If

    If Not tbl.InsertRowRange Is Nothing Then
        
        tbl.InsertRowRange.Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
        
    Else
        tbl.ListRows.Add
        tbl.ListRows(tbl.ListRows.Count).Range.Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
    End If
    
    Set rng = sht.Range("A28:Y42")
    
    If rng.Cells(rng.Rows.Count, 1).Value = "" Then
        Set rng = rng.Resize(rng.Rows.Count - 1, rng.Columns.Count)
    End If

    If Not tbl.InsertRowRange Is Nothing Then
        tbl.InsertRowRange.Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
        
    Else
        tbl.ListRows.Add
        tbl.ListRows(tbl.ListRows.Count).Range.Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
    End If
    
    wb.Close False
    
Next
End Sub
 
Joined
Nov 21, 2016
Messages
32
Hi FatBoyClam,

Unfortunately each workbook worksheet has an individual id also (ie 00001, 00002, 00003) - will that change anything?

All other assumptions are correct!

Thank you for your help on this front!
 

FatBoyClam

Board Regular
Joined
Jan 8, 2020
Messages
183
Office Version
365
Platform
Windows
Is there a pattern to the worksheet ID? For example, could the Worksheet ID be determined from the workbook name?

You say it's the sheet the workbook opens to - we could use ActiveSheet, but I am loathe to do so, as it's a clear risk, unless it's because it's the only worksheet in the workbook.

An alternative approach is: are there any distinguishing features of the worksheet - for example, the column Headers appear in cells A1:Y1 and would not appear on any other sheet, so we can simply poll through the worksheets in the workbook and check A1 and B1, let say, for the first two column headers, and use whatever sheet we find those on.
 

Watch MrExcel Video

Forum statistics

Threads
1,099,137
Messages
5,466,893
Members
406,507
Latest member
donwiss

This Week's Hot Topics

Top