Как динамически скопировать содержимое двух ячеек?

Question

Прямо сейчас моя программа работает. Но мне нужно скопировать другую ячейку, которая находится рядом с копируемой ячейкой, когда найдено совпадение. Я прохожу myrange1 и, когда я нахожу совпадение в myrange2, я копирую содержимое из столбца A в Sheet1 из любой ячейки, в которой оно находится. Я хочу, чтобы столбец B, тот же индекс ячейки, также копировался и вставлялся. Мои скопированные данные вставляются в столбец (столбцы) R: S. Лист2. Столбец R - это числа, а S - это данные.

Sub matchcopy()
    Dim i&
    Dim myrange1 As Range, myrange2 As Range, myrange3 As Range, cell As Range
    ' You can use the Codenames instead of Worksheet("Sheet1") etc.
    Set myrange1 = Sheet1.Range("A1", Sheet1.Range("A" & Rows.Count).End(xlUp))
    Set myrange2 = Sheet2.Range("A1", Sheet2.Range("A" & Rows.Count).End(xlUp))
    Set myrange3 = Sheet2.Range("B1", Sheet2.Range("B" & Rows.Count).End(xlUp))

    Sheet2.Range("R:S") = ""                 ' <~~ clear result columns

    For Each cell In myrange1               ' presumably unique items
        If Not IsError(Application.Match(cell.Value, myrange2, 0)) Then
            'Sheet2.Cells(i, 2).Offset(, 1).Resize(1, 1).Copy

            cell.Copy
            With Sheet2.Range("R50000").End(xlUp)
                 i = i + 1                    ' <~~ counter
                .Offset(1, 0) = i            ' counter i equals .Row - 1
                .Offset(1, 1).PasteSpecial xlPasteFormulasAndNumberFormats
            End With

        Else
            'MsgBox "no match is found in range"
        End If
    Next cell

    Sheet2.Columns("R:S").EntireColumn.AutoFit
    Call Set_PrintRnag                      
End Sub


Sub Set_PrintRnag()
Dim LstRw As Long
Dim Rng As Range
Dim strDesktop As String

Application.ScreenUpdating = True
strDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop")

LstRw = Sheet2.Cells(Rows.Count, "R").End(xlUp).Row
Set Rng = Sheet2.Range("R1:S" & LstRw)
With Sheet2.PageSetup
    .LeftHeader = "&C &B &20 Cohort List Report:" & Format(Now, "mm/dd/yyyy")
    .CenterFooter = "Page &P of &N"
    .CenterHorizontally = False
    .FitToPagesWide = 1
    .RightFooter = ""
End With

Rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strDesktop & "\CohortList " & " " & Format(Date, "mm-dd-yyyy") & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub

Answer 1

https://docs.microsoft.com/en-us/office/vba/api/excel.range.offset

У вас есть ячейка в столбце «A», НО вы хотите такую ​​же строку в столбце «B».

cell.Offset(0,1).value = cell.value