Macro to combine data from 2 sheets if ID# matches

[jgonzalez4]

I have two sheets (Sheet1, Sheet2). Sheet1 has data from Column A to Column P. Sheet2 has a different set of data from Column A to Column G. Column A in both sheets is an ID#. What I'm looking to do is have a macro that if the ID# in sheet2 Column A matches an ID# in Sheet1 Column A, put Sheet 2 Column B through G data into Sheet1 Column Q to V.

Please note that the ID#'s do not line up in the same row between Sheets 1 and 2.

Example:
Sheet1

[TABLE="width: 500"]
<tbody>[TR]
[TD]ID#[/TD]
[TD]First[/TD]
[TD]Last[/TD]
[TD]Age[/TD]
[/TR]
[TR]
[TD]101112[/TD]
[TD]Jane[/TD]
[TD]Smith[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]109854[/TD]
[TD]John[/TD]
[TD]Doe[/TD]
[TD]35[/TD]
[/TR]
[TR]
[TD]104695[/TD]
[TD]Jimmy[/TD]
[TD]Deen[/TD]
[TD]19[/TD]
[/TR]
[TR]
[TD]456954[/TD]
[TD]Alice[/TD]
[TD]Wonderland[/TD]
[TD]30[/TD]
[/TR]
</tbody>[/TABLE]


Sheet2
[TABLE="width: 500"]
<tbody>[TR]
[TD]ID#[/TD]
[TD]Unit[/TD]
[TD]Enrollment Source[/TD]
[TD]Instrument[/TD]
[/TR]
[TR]
[TD]456954[/TD]
[TD]1[/TD]
[TD]ENT[/TD]
[TD]Guitar[/TD]
[/TR]
[TR]
[TD]109854[/TD]
[TD]6[/TD]
[TD]ENT[/TD]
[TD]Bass[/TD]
[/TR]
[TR]
[TD]659841[/TD]
[TD]3[/TD]
[TD]ENT[/TD]
[TD]Drums[/TD]
[/TR]
[TR]
[TD]101112[/TD]
[TD]4[/TD]
[TD]RT[/TD]
[TD]Voice[/TD]
[/TR]
</tbody>[/TABLE]

After the Macro:
Sheet1
[TABLE="width: 500"]
<tbody>[TR]
[TD]ID#[/TD]
[TD]First[/TD]
[TD]Last[/TD]
[TD]Age[/TD]
[TD]Unit[/TD]
[TD]Enrollment Source[/TD]
[TD]Instrument[/TD]
[/TR]
[TR]
[TD]101112[/TD]
[TD]Jane[/TD]
[TD]Smith[/TD]
[TD]20[/TD]
[TD]4[/TD]
[TD]RT[/TD]
[TD]Voice[/TD]
[/TR]
[TR]
[TD]109854[/TD]
[TD]John[/TD]
[TD]Doe[/TD]
[TD]35[/TD]
[TD]6[/TD]
[TD]ENT[/TD]
[TD]Bass[/TD]
[/TR]
[TR]
[TD]104695[/TD]
[TD]Jimmy[/TD]
[TD]Deen[/TD]
[TD]19[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]456594[/TD]
[TD]Alice[/TD]
[TD]Wonderland[/TD]
[TD]30[/TD]
[TD]1[/TD]
[TD]ENT[/TD]
[TD]Guitar[/TD]
[/TR]
</tbody>[/TABLE]

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim ID As Range
    Dim foundID As Range
    For Each ID In Sheets("Sheet2").Range("A2:A" & LastRow)
        Set foundID = Sheets("Sheet1").Range("A:A").Find(ID, LookIn:=xlValues, LookAt:=xlWhole)
        If Not foundID Is Nothing Then
            Sheets("Sheet2").Range("B" & ID.Row & ":G" & ID.Row).Copy Sheets("Sheet1").Range("Q" & foundID.Row)
        End If
    Next ID
    Application.ScreenUpdating = True
End Sub

 

[jgonzalez4]

This did exactly what I needed. Thank you very much! This made my job easy without having to manually transfer over 3,000 records.

 

[mumps]

My pleasure.

 

[finspa]

Although this was originally posted a few tears ago, I wanted to add my thanks as it solved a problem I had and yet seems so simple!

 

[mumps]

Glad you found it useful.