VBA search & copy value from different WS

[EMcK01]

Hi,

I'm trying to search a range for a name, look in another sheet to match the name then copy an offset from this table to then bring back to my original sheet.

The first bit of searching the name to define what is being looked for is fine, however I'm unsure what I need to set the paste code as so it returns the found value.

This is where the code is falling down

Worksheets("export").ActiveCell.Offset(0, 1).PasteSpecial xlPasteValues

The full script is this

Sub GetName
Dim lr As Long, rng As Range

    lr = Range("A" & Rows.Count).End(xlUp).Row
                      
      Set rng = Range("A2:A" & lr)
              For Each cell In rng
      
              If cell.Value <> "" Then

    rngY = cell

    Sheets("Ref").Select
    Columns("B:B").Select
    Selection.Find(What:=rngY, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        matchCase:=False, SearchFormat:=False).Activate
      
    ActiveCell.Select

    ActiveCell.Offset(0, 5).Copy
    Worksheets("export").ActiveCell.Offset(0, 1).PasteSpecial xlPasteValues
        End If
    Next cell
End Sub

 

[Fluff]

How about

Sub EMcK()
   Dim Cl As Range
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = 1
   With Sheets("Ref")
      For Each Cl In .Range("B2", .Range("B" & Rows.Count).End(xlUp))
         If Cl <> "" Then Dic(Cl.Value) = Cl.Offset(, 5).Value
      Next Cl
   End With
   With Sheets("Export")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Dic.Exists(Cl.Value) Then Cl.Offset(, 1).Value = Dic(Cl.Value)
      Next Cl
   End With
End Sub

 

[EMcK01]

Thanks Fluff, thats worked perfectly for me.

Again I appreciate the help.

 

[Fluff]

You're welcome & thanks for the feedback.