Сравните две ячейки и скопируйте их / 2 книги

Question

Я надеюсь, что кто-то может мне помочь .. Я новичок и сижу здесь уже 5 часов, чтобы выполнить эту работу: (

Мне нужно сравнить две ячейки. Когда ячейка 1 имеет то же значение, что и ячейка 2 Мне нужно скопировать значение в следующие 3 ячейки рядом с ячейкой 2. Если они не совпадают, то l oop должно go на одну ячейку вниз. И это до последней заполненной ячейки.

Рабочая тетрадь 1 имеет диапазон G1: G100, который следует сравнить с рабочей книгой 2, и диапазон B1: 100

Если содержимое одинаково в обеих, то мне нужно скопировать 3 ячейки рядом с диапазоном WB2, где ячейки похожи C1: E100

И вот код, который у меня есть

Public Sub zusammenführen()
Dim cell As Range
Dim wb1 As Workbook
Set wb1 = ThisWorkbook
Dim wb2 As Workbook
Set wb2 = Application.Workbooks.Open("T:\folder\LWTP.xlsx")

For Each cell In wb1.Sheets(1).Range("G1:G100")
    If ActiveCell.Value = wb2.Sheets("LWTP").Range("B1:B100").Value Then
    MsgBox "Test"

    End If
Next cell
End Sub

Надеюсь, вы понимаете мой английский sh Спасибо за помощь!

Answer 1

Попробуйте это:

Public Sub zusammenführen()
    Dim cell As Range
    Dim wb1 As Workbook
    Dim wb2 As Workbook, ws2 as worksheet

    Set wb1 = ThisWorkbook   
    Set wb2 = Application.Workbooks.Open("T:\folder\LWTP.xlsx")
    Set ws2 = wb2.Sheets("LWTP") 

    For Each cell In wb1.Sheets(1).Range("G1:G100")
        If cell.Value = ws2.Cells(cell.Row, "B").Value Then

            cell.offset(0, 1).Resize(1, 3).Value = _
                ws2.Cells(cell.Row, "C").Resize(1, 3).Value

        End If
    Next cell

End Sub