Huge problem with comparing cells in different ranges and sheets

[Monoxito]

Hi!
Could anyone help me with this one.
I have two sheets: "Report" and "Data". On Report-sheet I have two columns
AE and AF. On AE there are 13 names in random order 40 times on area
"AE1:AE40" and on AF i have random values on area "AF1:AF40".
On Data-sheet I have same 13 names on area "A1:A13".
I need macro that will copy value from AF1 to AF40 if the name on AE1 is
same as A1. And so on...Something like this:

Report-sheet Data-sheet
DA 2354 DA 2354 98 887
EA 3321 DB
FG 3214 EA 3321
DA 98 ...
DA 887
...

I've been strugling with this one over 3 days, so any help will be
appreciated.

 

[JLGWhiz]

1. Do you want the pasted values to begin in column B of "Data"?
2. Do you want the values pasted in their individual cells horizontally for
each name?
Or
3. Do you want the values pasted in the same cell, delimited with a space?

 

[Don Guillett]

Sub copylikecells() 'from the destination sheet list in col E
For i = 2 To Cells(Rows.Count, "e").End(xlUp).Row
With Sheets("Sheet22").Columns(2)'modify to suit source
Set c = .Find(Cells(i, "e").Value, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
lc = Cells(i, Columns.Count).End(xlToLeft).Column + 1
c.Offset(, 1).Copy Cells(i, lc)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next
End Sub

 

[JLGWhiz]

Assuming you want the values to be listed in individual cells horizontally
starting in columb B.

Sub cpyVpstH()
Dim lstCol As Long
lstCol = Worksheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column
Set srcRng = Worksheets("Data").Range("$A$1:$A$13")
Set Wksr = Worksheets("Report")
For Each C In srcRng
If Not C Is Nothing Then
x = C.Address
End If
a = 1
For i = 1 To 40
If C = Wksr.Cells(i, 31) Then
Wksr.Cells(i, 31).Offset(0, 1).Copy Cells(Range(x).Row, lstCol + a)
a = a + 1
End If
Next i
Next C
End Sub

 

[Don Guillett]

Findnext should be a bit more efficient

 

[Monoxito]

Thanks both of you for your trouble. I think it works, but it just doesn't
paste anything. Could you help me with that one?
And yes, values should be in individual cells. I need to make dynamic graph
out of this and it has quite a lot of data on it.

"JLGWhiz" kirjoitti:

 

[Don Guillett]

My posting was tested. You just need to adjust to YOUR data layout. It
assumes that you focus(cursor) is on the sheet of the destination list. It
assumes that this list starts on row 2 of col E. It assumes that your source
data is on sheet22 in col B and that the numbers desired are in col C.

Sub copylikecells() 'from the destination sheet list in col E
For i = 2 To Cells(Rows.Count, "e").End(xlUp).Row
With Sheets("Sheet22").Columns(2)'modify to suit source
Set c = .Find(Cells(i, "e").Value, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
lc = Cells(i, Columns.Count).End(xlToLeft).Column + 1
c.Offset(, 1).Copy Cells(i, lc)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next
End Sub

 

[Monoxito]

Yes ofcourse, now it works very well. I misread and misunderstood the code
wrong. Thank you very much for your trouble.

"Don Guillett" kirjoitti:

 

[Don Guillett]

Glad you got it sorted out.