If number in Column A matches number in column B - Copy B cell and adjacent cells ?

Hi,

I'm trying to update a macro I'm currently using but I need to expand a little further. Below is what I am trying to achieve:

Ref #1	Ref #1a	Ref #2	Qty.	REF#1a	REF#2	Qty.
TEST0000001	TEST0000007	123	1	TEST0000004	127	1
TEST0000002	TEST0000009	123	1
TEST0000003	TEST0000011	124	1
TEST0000004	TEST0000019	127	2
TEST0000005	TEST0000004	127	1

Basically, if a number in Column A (REF#1) matches a number in Column B (Ref#1a) I'd the macro to copy REF#1a and the adjacent cells to the right and paste them in a new column.

Does anyone know how I might go about this because I'm absolutely stuck :s

Jack

Try:

Sub foo()
Dim x As Range, y As Range, z As Integer

With Sheet1
    For Each x In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        Set y = .Range("B2:B" & .Cells(Rows.Count, 2).End(xlUp).Row).Find(x.Value)
        If Not y Is Nothing Then
            With .Cells(Rows.Count, 5).End(xlUp)
                For z = 0 To 2
                    .Offset(1, z).Value = y.Offset(0, z).Value
                Next z
            End With
        End If
    Next x
End With

End Sub

That code works perfectly for the example, thank you.

Try:

Sub bar()
Dim x As Range

With Sheet1
    For Each x In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        If Not .Range("B2:B" & .Cells(Rows.Count, 2).End(xlUp).Row).Find(x.Value) Is Nothing Then
            .AutoFilterMode = False
            .Range("B1:D" & .Cells(Rows.Count, 1).End(xlUp).Row).AutoFilter field:=1, Criteria1:=x.Value
            With .AutoFilter.Range
                .Offset(1, 0).Resize(.Rows.Count - 1, 3).Copy
            End With
            .AutoFilterMode = False
            .Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
            Application.CutCopyMode = False
        End If
    Next x
End With

Glad you got it sorted.