tlchan
06-30-2018, 06:29 PM
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
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