Find Query

Hi,

I have a value in A1 on Sheet1 of a workbook and, for each instance of the same value in column D on Sheet2, I need to copy the values in the next 2 adjacent cells and paste them to Column K-L on Sheet3. I'm guessing that FIND is a better way than using vlookup but then I get totally lost. Can anyone help please?

Many thanks

Yes, it looks like. Could you please attach a sample book with a desired result?

Many thanks in anticipation, here's a workbook which i've simplified for this purpose

M

Book1.xls

Mike,
Try this one and see how it goes.

Sub find_copy()
Dim c2 As Range, c As Range
With Sheets("Sheet2")
 For Each c2 In .Range("B2:B" & .Cells(Rows.Count, 3).End(xlUp).Row).SpecialCells(12)
   Set c = Sheets("Sheet1").Columns(1).Find(c2, , xlValues, xlWhole)
    If Not c Is Nothing Then
    c2.Offset(, 3).Resize(, 2).Copy Sheets("sheet3").Cells(Rows.Count, 11).End(xlUp).Offset(1).Resize(, 2)
    End If
   Next c2
 End With
End Sub

Many thanks!! This almost works perfectly. It copies the column headers each time it runs for some reason though

Mike! Sorry Mate!
It was actually a wrong code. The code was looking at Columns "B", instead of D.
I think this is correct.

Sub find_copy()
Dim c2 As Range, c As Range
With Sheets("Sheet2")
LR = .UsedRange.Rows.Count
On Error Resume Next
 For Each c2 In .Range("D2:D" & LR)
   Set c = Sheets("Sheet1").Columns(1).Find(c2, , xlValues, xlWhole)
    If Not c Is Nothing Then
    c2.Offset(, 2).Resize(, 2).Copy Sheets("sheet3").Cells(Rows.Count, 11).End(xlUp).Offset(1).Resize(, 2)
    End If
   Next c2
 End With
End Sub

Hi, apologies for the delay getting back to you. Your re-posted code works perfectly! Many thanks again for your help