Extracting data from multiple workbook and storing them in masterworkbook column wise

[Sayan2795]

Hi,
I am new in VBA so I having problem with a a particular problem statement.
I have multiple workbooks in one folder which are reports in a specific format. I need to extract specific cells and one whole column from each workbook and store it in a masterworkbook. The information which I need to extract is
1. Date - cell D4
2. ID - cell E10
3. Column of data B14 to B247

I need these automated and stored in a masterworkbook.
In the master workbook I need to store it in such a way that the data from each file is stored columnwise ie Workbook 1 day in B column, workbook2 data in C column , workbook 3 in D column and so on depending on the number of files in the folder.
Also about the date should be stored as such that for each file data, Date in row 1, id in row 2 and the rest of the data below it.

Please help. I am really new at this and can't seem to get it right.

Thank you for your help and time

 

[jolivanes]

From how many sheets in each Workbook?
What are the names of these Sheets or in what order need data to be copied?
If it is from just one Sheet, which Sheet? First, second or whatever.
Is the Master Workbook also saved in that same Folder?
Are there any other Workbooks in that same Folder?
If so, how can one distinguish between the Workbooks?

 

[jolivanes]

The Workbook with this code in it needs to be saved in the same folder as the Workbooks you're copying from.
No other Workbooks in that Folder. (Workbooks you don't want to copy from)
All sheets are Sheet1 in this code. Change as required.
It assumes you want to start pasting in the first Row (no headers). If there are headers, increase the 1, 2 and 3 by 1.

Sub Maybe_Like_So()
    Dim wb As String, i As Long
    
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    i = 2
    wb = Dir(ThisWorkbook.Path & "\*")
    Do Until wb = ""
        If wb <> ThisWorkbook.Name Then
            Workbooks.Open ThisWorkbook.Path & "\" & wb
                With ThisWorkbook.Sheets("Sheet1")
                    .Cells(1, i) = Workbooks(wb).Sheets("Sheet1").Cells(4, 4)
                    .Cells(2, i) = Workbooks(wb).Sheets("Sheet1").Cells(10, 5)
                    .Cells(3, i).Resize(234) = Workbooks(wb).Sheets("Sheet1").Cells(14, 2).Resize(234).Value
                End With
            Workbooks(wb).Close False
        End If
        wb = Dir
    i = i + 1
    Loop
    
    With Application
        .Calculation = xlAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

 

[Sayan2795]

Thank you @jolivanes for your prompt reply I am grateful.
To answer the questions you asked :-
1. Only one sheet from each notebook named ' Reports' and it's the first sheet
2.the master workbook is not saved in the folder. The workbooks are automatically generated from a machine and stored in one folder everyday. Everyday it creates 50 reports( workbooks) and it is on a server. So I can't always place the masterworkbook in the folder and work due to work constraints.
3.There are multiple workbooks in this folder. I need to pick data from the each workbook( the exact same range and cells) and place then in a master workbook.
3. The date that I pick from each workbook in cell D4 needs to become the header of each column

 

[Sayan2795]

Also the file names are different. Each file has a name based on id but all files have similar format data

 

[jolivanes]

Try this.
Change references if and/or where required

Sub Get_Info()
    Dim sPath As String
    Dim sFil As String
    Dim owb As Workbook
    Dim twb As Workbook

    Dim i As Long
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    i = 2
    Set twb = ThisWorkbook    '<----- Master Workbook which has the code in it
    sPath = "E:\Folder A\Sub Folder A" & "\"   '<----- Change Path as required
    sFil = Dir(sPath & "*.xl*")
    Do While sFil <> ""
        Set owb = Workbooks.Open(sPath & sFil)

            With twb.Sheets("Reports")    '<----- Change Sheet Name in Master Workbook as required            
                    .Cells(1, i) = owb.Sheets("Reports").Cells(4, 4)
                    .Cells(2, i) = owb.Sheets("Reports").Cells(10, 5)
                    .Cells(3, i).Resize(234) = owb.Sheets("Reports").Cells(14, 2).Resize(234).Value
            End With

        owb.Close False 'Close no save
        sFil = Dir
        i = i + 1
    Loop
    With Application
        .Calculation = xlAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

 

[Sayan2795]

Thank you @jolivanes. It worked perfectly. You are the best

 

[jolivanes]

Thank for the feed back.
Good luck.