bookBから2列にまたがるデータを引用して、bookAに正しいデータを貼り付けたい（Excel）

下記のマクロを bookA の標準モジュールにはりつけて、copy_data サブルーチンを実行してください。

Const REF_BOOK = "D:\data\bookB.xlsx"   ' bookB のフルパス

Function is_blank_cell(c)
    is_blank_cell = IsEmpty(c) Or c.Value = ""
End Function

Sub copy_data()
    search_word = "りんごごりら"
    target_column = 46              ' AT列
    ref_column = 7                  ' G列

    Set this_book = ActiveWorkbook
    Set bookB = Workbooks.Open(REF_BOOK)
    this_book.Activate
    Set ref_sheet = bookB.Sheets(1)     ' bookB の 1番目のシート

    last_row = Cells(Rows.Count, target_column).End(xlUp).Row
    last_row_b = ref_sheet.Cells(Rows.Count, ref_column).End(xlUp).Row

    last_blank_row = -1
    last_blank_row_b = -1

    For r = 1 To last_row
        If is_blank_cell(Cells(r, target_column - 5)) Then
            last_blank_row = r
        End If
        If InStr(Cells(r, target_column).Value, search_word) > 0 Then
            Key = Cells(r + 1, target_column - 5).Value
            rr = -1
            For r2 = 1 To last_row_b
                If is_blank_cell(ref_sheet.Cells(r2, ref_column)) Then
                    last_blank_row_b = r2
                End If
                If ref_sheet.Cells(r2, ref_column).Value = Key Then
                    rr = last_blank_row_b
                    Exit For
                End If
                DoEvents
            Next
            If last_blank_row <> -1 And rr <> -1 Then
                Set s_range = ref_sheet.Range(ref_sheet.Cells(rr, ref_column + 5), ref_sheet.Cells(rr, ref_column + 6))
                rd = last_blank_row
                Set d_range = Range(Cells(rd, target_column), Cells(rd, target_column + 1))
                s_range.Copy d_range
            End If
        End If
        DoEvents
    Next
    bookB.Close SaveChanges:=False
    MsgBox "FINISH !"
End Sub

今回も、分レベルの処理時間がかかりそうなので、終わったらメッセージボックスを表示するようにしてみました。

一応、テストデータを作って試してはみましたが、実物で試していないので、題意を汲み取れているか不安なところはあります。
＃ まあ、人力検索だとやり取りが第三者に見えてしまうので、実物をもらうのは厳しいところですが。