Collate selective columns from multiple workbooks

Invade2017

New Member
Joined
Dec 6, 2017
Messages
2
Hi All,

I have 18 different workbooks saved in 1 folder (Workbook 1, Workbook 2, Workbook 3 etc) with the same worksheet names (Sheet 1, Sheet 2, Sheet 3 and Sheet 4), in all the 18 workbooks.

I need to collate the data in Sheet 2 of all the 18 workbooks

Sheet 2 of all the 18 workbooks has more than 20 columns (Column A, Column B, Column C, Column D etc)

The data that needs to be collated from Sheet 2 of all the 18 workbooks in the new workbook is as below:

New Workbook

[TABLE="class: grid, width: 336"]
<tbody>[TR]
[TD="width: 56, align: center"]COLUMN A[/TD]
[TD="width: 56, align: center"]COLUMN B[/TD]
[TD="width: 56, align: center"]COLUMN C[/TD]
[TD="width: 56, align: center"]COLUMN D[/TD]
[TD="width: 56, align: center"]COLUMN E[/TD]
[TD="width: 56, align: center"]COLUMN F[/TD]
[/TR]
[TR]
[TD] Data from Sheet 2 Column C[/TD]
[TD] Date from Column D (Yesterday's Date Only)[/TD]
[TD] Data from Sheet 2 Column F[/TD]
[TD] Data from Sheet 2 Column G[/TD]
[TD] Data from Sheet 2 Column I[/TD]
[TD] Data from Sheet 2 Column L[/TD]
[/TR]
</tbody>[/TABLE]


Column D has date in all the Sheet 2's of all the 18 Workbooks - I only need to collate data for yesterday's date (not the entire list)

Do message for any clarification.

P.S. This is very important and any help would be highly appreciated

Regards
Bharat Makwana
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Hi Invade2017,

Welcome to the MrExcel Forum.

See if this is close to what you need. I took your Workbook names exactly as you have in your post, however I changed "Sheet 2" to "Sheet2". If this is incorrect I noted in the code where you would enter the correct name. Copy the code to a new workbook.

Code:
Sub GetData()
    
    Dim FSO As Object
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim nam As Integer, i As Long, lCol As Long, ctif As Long, x As Long, lRow As Long
    Dim strFileName As String, strFolder As String, xPath As String, folderName As String
    Dim rarr
    
    Application.ScreenUpdating = False
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select A Folder!"
        .ButtonName = "Confirm"
            If .Show = -1 Then
                folderName = .SelectedItems(1)
            Else
                MsgBox "You didn't select a folder.", vbExclamation, "Folder Not Selected!"
                Exit Sub
            End If
    End With
    strFolder = folderName & "\"
    strFileName = Dir(strFolder)
    xPath = strFolder
    nam = 1
    Do Until nam = 19
        If strFileName = "Workbook " & nam & ".xlsm" Then
            Workbooks.Open (xPath & strFileName)
            Worksheets("Sheet2").Activate    'Make sure Sheet name is correct
            ctif = WorksheetFunction.CountIf(Range("D:D"), Date - 1)
            lCol = Cells(1, Columns.Count).End(xlToLeft).Column
            ReDim rarr(ctif - 1, 5)
            For i = 1 To Worksheets("Sheet2").UsedRange.Rows.Count
                If Cells(i, 4) = Date - 1 Then
                        rarr(x, 0) = Cells(i, 3)
                        rarr(x, 1) = Cells(i, 4)
                        rarr(x, 2) = Cells(i, 6)
                        rarr(x, 3) = Cells(i, 7)
                        rarr(x, 4) = Cells(i, 9)
                        rarr(x, 5) = Cells(i, 12)
                        x = x + 1
                End If
                If x = ctif Then Exit For
            Next
            Application.ActiveWorkbook.Close False
            lRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            Range("A" & lRow).Resize(UBound(rarr, 1) + 1, 6) = rarr
            nam = nam + 1
        End If
        strFileName = Dir
        If strFileName = "" Then GoTo CleanUp
        x = 0
   Loop
   
CleanUp:
 
    MsgBox "Operation Complete"
    Application.ScreenUpdating = False


End Sub

I hope this helps.
 
Upvote 0
Thanks a Lot igold for this code...

i have tried using the code ----- :-(
actually i am a newbie in VBA

Also, the workbook names and the sheet names are different in the actual files - how do i accommodate the same in the code (where all do i need to make the changes - basically the first 3 words in all 18 the workbooks are the same i.e. "Output Master Tracker - London", "Output Master Tracker - Mumbai", "Output Master Tracker - Beijing" etc)

please help with the same ...
 
Upvote 0
Given this quote from you:

P.S. This is very important and any help would be highly appreciated

This information would have been nice to have had in your OP, especially if you do not have the minimum VBA knowledge required to change the code to suit your particular circumstances. This code did not just type itself, I actually had to compose the code and then type it in myself, giving freely of my time. Does this make any sense to you.

That said, now that I know the correct names of the workbooks. What is the correct name of the worksheet which you are calling "Sheet 2" in your OP.
 
Upvote 0

Forum statistics

Threads
1,223,967
Messages
6,175,672
Members
452,666
Latest member
AllexDee

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