Hi
try this
Code:
Option Explicit
Sub kTest()
Dim k() As String, i As Long, n As Long, myCells, wbkT As Workbook
Dim TemplatePath As String, FName As String, WbkName As String
Dim Concat As String
myCells = Array("E5", "D20", "C43", "D43", "C46", "D46", "C85", "D85", "C87", "D87")
TemplatePath = "C:\Test" '<<<< adjust the path here
If Right$(TemplatePath, 1) <> Application.PathSeparator Then TemplatePath = TemplatePath & Application.PathSeparator
ReDim k(1 To 150)
FName = Dir(TemplatePath & "*.xls*")
WbkName = ThisWorkbook.Name
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Do While Not FName = vbNullString
If FName <> WbkName Then
Set wbkT = Workbooks.Open(TemplatePath & FName)
Concat = vbNullString
For i = LBound(myCells) To UBound(myCells)
Concat = IIf(Len(Concat), Concat & "|" & wbkT.Worksheets(1).Range(myCells(i)).Value, wbkT.Worksheets(1).Range(myCells(i)).Value)
Next
n = n + 1
k(n) = Concat
wbkT.Close 0
Set wbkT = Nothing
End If
FName = Dir()
Loop
If n Then
With Worksheets(1)
'always overwrite the new data
.UsedRange.Offset(1).ClearContents
.Range("a2").Resize(n) = k
.Range("a2").Resize(n).TextToColumns .Range("A2"), Other:=True, OtherChar:="|"
End With
End If
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub
Bookmarks