Option Explicit
Sub ExtractData()
Dim ws As Worksheet
Dim Myrange As Range, C As Range
Dim MainFolderName As String, myFile As String, sName As String
Dim i As Long, v As Long
MainFolderName = ThisWorkbook.path
Set NewSht = ws.Sheets.Add
i = 1
myFile = Dir(MainFolderName & "\*.xls", vbNormal)
Do While Len(myFile) <> 0
Cells(1, 1) = Now()
v = 0
If myFile <> ThisWorkbook.Name Then
i = i + 1
sName = "Summary"
Set Myrange = Range("D9, I8:I10")
Cells(i, 1) = myFile
For Each C In Myrange
v = v + 1
Cells(i, 1 + v) = Application.ExecuteExcel4Macro("'" & MainFolderName & "\[" & myFile & "]" & sName & "'!" & C.Address(, , xlR1C1))
Next
Else
End If
myFile = Dir
Loop
Columns("A:A").AutoFit
End Sub
|