Use macro to retrieve data from a group of excel workbooks to a summary worksheet

[citylook]

Hi all,

This is my first post in this forum! Thanks all of you who previously guide me through the difficulties. This time I have to raise specific question as I have been very unsuccessful to find the the solution (because I am a basic excel user).

I created an spreadsheet "List", which contain the file name and full path (folder location + file name.xlsx) of the source data. All source files have the same standard format.

What I would like to achieve is to create a macro to retrieve a range of the data in a column on tab "TB" by referring to the "list", and paste it column by column in the the "summary" tab.

on the "summary" tab, each column should contains retrieved data from the sourcing files and the first cell of each column column should also have the source file name or full path.

Could you guy please help me with that?

Thanks in advance!

Citylook

 

[ParamRay]

.
.

Paste the following code into a normal code module in your "List" workbook.

Sub GetData()

    Dim FLst As Range
    Dim FPth As String
    Dim FCnt As Integer
    Dim FWbk As Workbook
    Dim Cell As Range
    Dim CRng As Range
    
    'Set range containing list of paths.
    '(Here I've assumed that the
    ''paths are contained in column A
    ''of the "TB" worksheet...)
    
    With ThisWorkbook.Worksheets("TB")
        Set FLst = Intersect(.Columns("A"), .UsedRange)
    End With
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    'Loop through each file in FLst
    'and copy contents of column A
    'into "Summary" worksheet...
    
    FCnt = 0
    For Each Cell In FLst
        
        If Cell.Value Like "*.xl*" Then
            FPth = Dir(Cell.Value)
            
            If FPth <> vbNullString Then
                FCnt = FCnt + 1
                ThisWorkbook.Worksheets("Summary").Cells(1, FCnt).Value = FPth
                Set FWbk = Workbooks.Open(Filename:=Cell.Value)
                
                With FWbk.Worksheets(1)
                    Set CRng = Intersect(.Columns("A"), .UsedRange)
                End With
                
                CRng.Copy
                ThisWorkbook.Worksheets("Summary").Cells(2, FCnt).PasteSpecial _
                    Paste:=xlPasteValuesAndNumberFormats
                FWbk.Close SaveChanges:=False
            End If
        
        End If
    
    Next Cell
    
    'Autofit columns in "Summary" worksheet
    ThisWorkbook.Worksheets("Summary").UsedRange.EntireColumn.AutoFit
                
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    MsgBox _
        Prompt:="Finished", _
        Buttons:=vbInformation, _
        Title:="Success"

End Sub

 

[citylook]

Thanks Gpeacock!

I haven't got a chance to test these code. But I always got error message about DIR() function.
Whenever I have DIR() function in my code, the system pop up "compile error: Wrong number of arguments or invalid property assignment"

Do you know why and how to resolve it?

Kind regards,

Citylook

 

[ParamRay]

Thanks Gpeacock!

I haven't got a chance to test these code. But I always got error message about DIR() function.
Whenever I have DIR() function in my code, the system pop up "compile error: Wrong number of arguments or invalid property assignment"

Do you know why and how to resolve it?

Kind regards,

Citylook

You can only call the DIR function with no arguments if you've previously called it with (at least) the pathname specified...

 

[citylook]

Thanks guys,

As I am a very basic user, I do not even know how to adjust the written code properly. So I tried a couple of hours for my own code, and luckily, they are working. the next step is improving below code.

Again gpeacok, thank you very much for your help, hopefully my skill can be improved while working on some of these minor projects.

Citylook

Sub GetData()
Dim FilePath As String
Dim FileName As String

FilePath = Sheets("List").Range("F3")
FileName = Sheets("List").Range("E3")

Workbooks.Open (FilePath)
Worksheets("TB").Activate
Range("R10:R304").Select
Selection.COPY
Workbooks("Financials.xlsm").Activate
Worksheets("summary").Activate
Range("C10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Workbooks(FileName).Activate
ActiveWorkbook.Close

Do
On Error GoTo Terminate

Dim i As Integer
i = i + 1


FilePath = Sheets("List").Range("F3").Offset(i, 0)
FileName = Sheets("List").Range("E3").Offset(i, 0)

Workbooks.Open (FilePath)
Worksheets("TB").Activate
Range("R10:R304").Select
Selection.COPY
Workbooks("Financials.xlsm").Activate
Worksheets("summary").Activate
Range("C10").Offset(0, i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Workbooks(FileName).Activate
ActiveWorkbook.Close

Loop


Terminate:
Exit Sub


End Sub

 

[citylook]

Thanks a lot gpeacock!