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