сравнения и копирования данных между рабочими листами

Question

Вот что я хотел бы сделать:

• IF
  • клетки Н листа А = ячейки Е рабочего листа В (содержат слова) и
  • Ячейка J рабочего листа A = ячейка H рабочего листа B (содержит номера) и
  • cell K of works Heet А = ячейка I из рабочего листа В (содержат цифры)
• ТОГДА
  • копию ячейки вывода из рабочего листа А к ячейке л рабочего листа В (содержат числа)

Другими словами:

• Если H2, J2, K2 листа A = E 1, H1, I1 рабочего листа B, затем скопируйте O2 рабочего листа A в L1 рабочего листа B.
• Если H3, J3, K3 листа A = E5, H5, I5 листа B, затем скопируйте O3 листа A в L5 рабочего листа B.

Макрос, который я хочу, должен совпадать и скопировать для всего листа A и B. Данные из листа A должны использоваться только один раз.

---

Это то, что у меня есть до сих пор, но оно, похоже, не работает.

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 Вам нужно две петли для того, что вы хотите сделать. Эта новая подпрограмма работает для любой строки. Будьте внимательны только для нескольких матчей, потому что это займет только последний матч:

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