如何动态复制两个单元格的内容？

Question

现在我的程序工作。但是，当找到匹配项时，我需要复制正在复制的单元格旁边的另一个单元格。我通过myrange1，当我在myrange2中找​​到一个匹配项时，我从Sheet1中的A列中复制内容。我希望复制和粘贴列B，相同的单元格索引。我复制的数据被粘贴在列R：S中。 Sheet2。列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