VBA Code

Joined
Nov 21, 2016
Messages
37
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!
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
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)?
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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!
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

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