こんな感じで｡

Sub set_data()
 ref_book_filename = "d:\foo\bar.xlsx"  ' 参照先の Book (ﾌﾙﾊﾟｽ)
 ref_column = 10  ' J列
 search_column = 18  ' R列
 write_column = search_column + 28  ' AT列

 Set this_book = ActiveWorkbook
 Set ref_book = Workbooks.Open(ref_book_filename)
 this_book.Activate

  ' 別ｼｰﾄの値を読み込む
 Set ref_sheet = ref_book.Sheets(1)  ' ひとつめのｼｰﾄ
 last_row = ref_sheet.Cells(Rows.Count, ref_column).End(xlUp).Row

 Set Map = CreateObject("Scripting.Dictionary")
 For r = 1 To last_row
 Set cell = ref_sheet.Cells(r, ref_column)
 If Not IsEmpty(cell) And Not cell.Value = "" Then
 If Not Map.Exists(cell.Value) Then
 Map.Add cell.Value, r
 End If
 End If
 DoEvents
 Next

  ' 対象ｼｰﾄから探して､値を書き込む
 last_row = Cells(Rows.Count, search_column).End(xlUp).Row
 For Each Key In Map.keys
 Debug.Print Key
 For r = 1 To last_row
 If InStr(Cells(r, search_column).Value, Key) > 0 Then
 rr = Map.Item(Key)
 ref_sheet.Range(ref_sheet.Cells(rr, ref_column + 2), ref_sheet.Cells(rr, ref_column + 4)).Copy _
 Cells(r + 1, write_column)
 Exit For
 End If
 DoEvents
 Next
 Next

 ref_book.Close
 Set ref_book = Nothing

 Set Map = Nothing

End Sub

ﾌﾞｯｸA の標準ﾓｼﾞｭｰﾙに上記のｺｰﾄﾞを追加して､set_data() ｻﾌﾞﾙｰﾁﾝを実行｡
前の質問と書き込み先(AT列)が被ってますが､大丈夫ですか？