循环搜索workbook1中的数据，将偏移单元格复制到workbook2

Question

I need a loop to copy cells offset from a found value in SOURCE, (based on range in DESTINATION) to DESTINATION.

In this case I want to copy value from SOURCE ("K10") to DESTINATION ("G5"), after value ("E10") found in SOURCE based on value ("H5") in DESTINATION.

I need to search for all values in DESTINATION ("H:H").

Book_source.xlsx

Book_destination.xlsx

My recorded code:

 Windows("Book_destination.xlsx").Activate
    Dim rng As Variant
    rng = Range("H5").Value

    rng.Select
    Selection.Copy
    Application.WindowState = xlNormal

    Windows("Book_source.xlsx").Activate
    Cells.Find(What:=rng, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

    ActiveCell.Offset(0, 6).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Book_destination.xlsx").Activate
    Range("G5").Select
    ActiveSheet.Paste

Answer 1

I created this code and is working for me. For anyone interested

Thanks all of you. :) Enjoy, it's free!

I'm glad to share this.

Sub part_of_code()

    Dim i As Integer
    i = 2

    'calling LastRow
    Call LastRecord(LastRow)

    For i = i To LastRow
        On Error Resume Next
        'Application.WindowState = xlNormal
        Range("H" & i).Select
        Selection.Copy
        Dim rng As Variant
        rng = Range("H" & i)

        Workbooks("Book2.xlsx").Worksheets("Sheet1").Activate
        Cells.Find(What:=rng, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(0, 6).Select
        Application.CutCopyMode = False
        Selection.Copy
        Workbooks("Book1.xls").Worksheets("Sheet2").Activate
        Range("H" & i).Offset(0, -1).Select
        ActiveSheet.Paste
    Next i

End Sub

Private Sub LastRecord(LastRow)
  With ActiveSheet
     LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  End With
End Sub