Try this

Sub test()
Set OldWbk = Workbooks("Main.xlsm")
Set newbk = Workbooks.Open(Filename:= _
"C:\My Document\" & OldWbk.Range("A1").Value & ".xlsm")

For Each cell In newbk.Range("I2:I15")

Data = cell.Offset(0, 1)
With OldWbk
Set c = .Range("D1:F1").Find(what:=cell, _
LookIn:=xlValues, loookat:=xlWhole)
If c Is Nothing Then
MsgBox ("could not find : " & cell)
Else
LastRow = .Cells(Rows.Count, c.Column).End(xlUp).Row
NewRow = LastRow + 1
.Cells(NewRow, c.Column) = Data
End If
End With
Next cell
End Sub



"K" wrote:

Hi all, I am looking for macro which should do something (see below)

EXAMPLE :

Sub test ()
set OldWbk = Workbooks("Main.xlsm")
Workbooks.Open Filename:= "C:\My Document\" & OldWbk.Range("A1").Value
& ".xlsm"
ActiveWorkbook.Range("I2:J15").Copy
OldWbk.Select
If (any cell.value) in OldWbk.Range("D1:F1") =
OldWbk.Range("A1").Value Then
Select.Offset.(of that cell).Paste
End Sub

Above is just rough example that what I want macro to do. Basically I
want macro to open workbook of which name is in Range("A1") and then
copy data from that workbook and then come back to old workbook and
look in each cell of Range("D1:F1") and if any cell have same value to
Range("A1") then Paste data one cell below of that cell. Please can
any friend help me on this