Copy specific data from an excel template and paste in new workbook

[excel_1317]

I have around 100 excel templates in a folder from which I need to extract data from specific cells and put in a separate workbook. Is this something that can be done macro. The logic is MACRO open first template -> Copy Specific Cells -> Paste into new workbook-> Close template-> Proceed open with next template....

The cells(Summary sheet) which we need to copy are E5, D20, C43, D43, C46, D46, C85, D85, C87 and D87. I am attaching sample template and final output file.

[Admin]

Hi

try this


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

[excel_1317]

Great!!!! Its working like charm.

[excel_1317]

I have created a folder C:\Test and put 2 sample templates. When i run the macro only information from the 1st template is copied twice(in two rows) in result file.

So information from second template is NOT copied at all.

Please look into it.

[excel_1317]

Please help..

[Excel Fox]

Can you check that the information in the two templates are not exactly the same?

EDIT: And add a back-slash for the path you specified

"C:\Test\"

[excel_1317]

I had changed the template name, cell E5 and cell D20..






Can you check that the information in the two templates are not exactly the same?

EDIT: And add a back-slash for the path you specified

"C:\Test\"

[Admin]

And add a back-slash for the path you specified

"C:\Test\"

That's already been taken care of in the code itself :)

replace
.Range("a2").Resize(n) = k

with


.Range("a2").Resize(n) = Application.Transpose(k)

[Excel Fox]

That's already been taken care of in the code itself

Yep, my bad. Only later did I notice that there was one whole line 'dedicated' to take care of that. :)

[excel_1317]

Thank you guys:)