How to copy the contents of two cells dynamically?

Question

Right now my program works. But, I need to copy another cell that's next to the cell being copied when a match is found. I go through myrange1 and when I find a match in myrange2, I copy the contents from Column A in Sheet1 from whichever cell it's at. I want column B, same cell index, to be copied and pasted as well. My copied data is getting pasted in Column(s) R:S. of Sheet2. Column R is the numbers and S is the data.

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

Thanks SJR. I'm able to copy and paste either A or B, but I cannot get both copy's to paste. It only handles one copy at a time. I need a way to concatenate Column A and B or have it paste both columns either in the same column or two different columns when it does the ".Offset(1, 1).PasteSpecial xlPasteFormulasAndNumberFormats" line — Curtis
Yes, it copied the same data into the column next to it. I have a column with Line numbers, a column with DOB, FN, LN in it and then I need a column next to it that has their address, race, gender etc. in it. Using that line got me my column with numbers, and two columns of DOB, FN and LN. — Curtis
One thing I didn't mention, I'm pretty new to VBA, so I apologize. I took out the cell.Copy and used cell.resize( ,2).Copy only and it worked. Thank you so much!!! — Curtis

Zamar Zamar · Accepted Answer · 2019-04-23T14:22:27

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

You have a cell in column 'A' BUT you want same row in column 'B'.

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

How to copy the contents of two cells dynamically?

1 Answers