Copy data from multiple files in a folder to master sheet

[tlchan]

Hi there,
I try to copy some data from multiple files in a folder to a master summary sheet with code as follows. However I only manage to open the folder dialog and cannot continue completion of the task.

I appreciate anyone could help.


Sub CopyPIDATA()
'
'
Dim fso As Object, folder, filelist, file
Dim ws As Worksheet, wb As Workbook
Set fso = CreateObject("Scripting.filesystemobject")


With Application.FileDialog(msoFileDialogFolderPicker)
'folder.AllowMultiSelect = False
.Show
'folder.SelectedItems (1)


If .Show = -1 Then ' if OK is pressed
folder = .SelectedItems(1)
End If
End With

If folder <> "" Then


Exit Sub


Set filelist = folder.Files
i = 1
For Each file In filelist
Set wb = Workbooks.Open(folder & "" & file.Name)
For Each ws In wb.Worksheets
i = i + 1

ThisWorkbook.Worksheets("Balance Sheet").Range("A" & i).Value = ws.Range("J1").Va

Workbooks(file.Name).Close
Next ws
Set ws = Nothing
Set file = Nothing


Next file


End If


End Sub

[mana]

Option Explicit


Sub CopyPIDATA()
    Dim targetFolder As String
    Dim fso As Object, f As Object
    Dim i As Long
    Dim ws As Worksheet, wb As Workbook
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then ' if OK is pressed
            targetFolder = .SelectedItems(1)
         Else
            Exit Sub
        End If
    End With
    
    Set fso = CreateObject("Scripting.filesystemobject")


    i = 1
    For Each f In fso.getfolder(targetFolder).Files
        If LCase(fso.getextensionname(f)) Like "xls*" Then
            Set wb = Workbooks.Open(f)
            For Each ws In wb.Worksheets
                i = i + 1
                ThisWorkbook.Worksheets("Balance Sheet").Range("A" & i).Value = ws.Range("J1").Value
            Next ws
            wb.Close
        End If
    Next f
    
    Set fso = Nothing


End Sub

[tlchan]

Hi mana,,

Thanks for the quick solution to ease my project.