Compare and copy data between worksheets

Question

Here's what I would like to do:

• IF
  • cell H of worksheet A = cell E of worksheet B (contain words) and
  • cell J of worksheet A = cell H of worksheet B (contain numbers) and
  • cell K of worksheet A = cell I of worksheet B (contain numbers)
• THEN
  • copy cell O of worksheet A to cell L of worksheet B (contain numbers)

In other words:

• If H2, J2, K2 of worksheet A = E1, H1, I1 of worksheet B, then copy O2 of worksheet A to L1 of worksheet B.
• If H3, J3, K3 of worksheet A = E5, H5, I5 of worksheet B, then copy O3 of worksheet A to L5 of worksheet B.

The macro I want should match and copy for the whole worksheet of A and B. Data from worksheet A is only to be used once.

---

Here's is what I have so far, but it doesn't seem to work.

Dim sh1 As Worksheet, sh2 As Worksheet
Dim j As Long, i As Long, lastrow As Long
Set sh1 = Worksheets("Worksheet A")
Set sh2 = Worksheets("Worksheet B")

lastrow = sh1.Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To lastrow
   j = (i - 2) * 4 + 1
   If sh1.Cells(i, "H").Value = sh2.Cells(j, "E").Value And _
      sh1.Cells(i, "J").Value = sh2.Cells(j, "H").Value And _
      sh1.Cells(i, "K").Value = sh2.Cells(j, "I").Value Then
      sh1.Cells(i, "O").Copy sh2.Cells(j, "L")
   End If
   j = j + 4
Next

Answer 1

Update You need two loops for what you want to do. This new subroutine works for any row. Just be careful of multiple matches because it will take only the last match:

Sub CopyCells()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim j As Long, i As Long, lastrow1 As Long, lastrow2 As Long
    Set sh1 = Worksheets("Worksheet A")
    Set sh2 = Worksheets("Worksheet B")

    lastrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row
    lastrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastrow1
        For j = 1 To lastrow2
            If sh1.Cells(i, "H").Value = sh2.Cells(j, "E").Value And _
                sh1.Cells(i, "J").Value = sh2.Cells(j, "H").Value And _
                sh1.Cells(i, "K").Value = sh2.Cells(j, "I").Value Then
                sh1.Cells(i, "L").Value = sh2.Cells(j, "O").Value
            End If
        Next j
    Next i
End Sub