自動化したい作業のｲﾒｰｼﾞを再確認です｡

bookA の AT?AU列に間違ったﾃﾞｰﾀがあって､それを bookB の L?M列のﾃﾞｰﾀで書き換えたい｡
正しいﾃﾞｰﾀは､bookA の一行下の AO列と bookB の G列とが一致する行で､その一行上のもの｡

bookA

bookB

処理実行後の bookA

作業のｲﾒｰｼﾞがあってるとして､こんな感じでどうでしょうか｡

Const REF_BOOK = "D:\data\bookB.xlsx"  ' bookB のﾌﾙﾊﾟｽ
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

 For r = 1 To last_row
 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 ref_sheet.Cells(r2, ref_column).Value = Key Then
 rr = r2
 Exit For
 End If
 DoEvents
 Next
 If rr <> -1 Then
 Set s_range = ref_sheet.Range(ref_sheet.Cells(rr - 1, ref_column + 5), ref_sheet.Cells(rr - 1, ref_column + 6))
 Set d_range = Range(Cells(r, target_column), Cells(r, target_column + 1))
 s_range.Copy d_range
 End If
 End If
 DoEvents
 Next
 bookB.Close SaveChanges:=False
End Sub

上記のﾏｸﾛは､bookA の標準ﾓｼﾞｭｰﾙにはりつけてください｡

• bookB のﾌﾙﾊﾟｽ (REF_BOOK)
• AT列を検索する語句 (search_word)

ﾏｸﾛ中の上記を適切なものに変えて､bookA の修正したいｼｰﾄを選択した状態で､ｻﾌﾞﾙｰﾁﾝ copy_data を実行してください｡
＃ 念のため書いておきますが､ﾊﾞｯｸｱｯﾌﾟを取ってから実行してください

bookB の､どのｼｰﾄを見るかという指定がなかったので､一番目のｼｰﾄから探すようにしています｡
処理が終了すると､bookB は自動的に閉じます｡
bookB に変更点があっても､無視して閉じるようにしてあるので､bookB に手を加えた場合には､注意してください｡

検索対象の AT列の文字の長さにもよりますが､bookA の行数というよりは置き換えるﾃﾞｰﾀの数で処理時間が決まってくると思うので､それほど時間はかからずに終了すると思います｡



上記のﾏｸﾛは､bookA で該当ﾃﾞｰﾀが見つかるたびに､bookB を探しているのですが､bookB のｼｰﾄの行数が多いと遅いかもしれません｡
ｺﾒﾝﾄで､修正するﾃﾞｰﾀは一種類だけのようなことを書かれていたので､bookB の正しいﾃﾞｰﾀを覚えておくようにしたのが､次のﾏｸﾛです｡

Const REF_BOOK = "D:\data\bookB.xlsx"  ' bookB のﾌﾙﾊﾟｽ
Sub copy_data2()
 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

 prev_key = ""
 Set ref_range = Nothing
 For r = 1 To last_row
 If InStr(Cells(r, target_column).Value, search_word) > 0 Then
 Key = Cells(r + 1, target_column - 5).Value
 If prev_key <> Key Then
 Set ref_range = Nothing
 For r2 = 1 To last_row_b
 If ref_sheet.Cells(r2, ref_column).Value = Key Then
 prev_key = Key
 Set ref_range = ref_sheet.Range(ref_sheet.Cells(r2 - 1, ref_column + 5), ref_sheet.Cells(r2 - 1, ref_column + 6))
 Exit For
 End If
 DoEvents
 Next
 End If
 If Not ref_range Is Nothing Then
 Set d_range = Range(Cells(r, target_column), Cells(r, target_column + 1))
 ref_range.Copy d_range
 End If
 End If
 DoEvents
 Next
 bookB.Close SaveChanges:=False
End Sub

こちらは､必要ないかもしれませんが､一応おいときます｡