Não é bonito, mas é curto e é um começo.
SubcollectRows()SetrngInput=Range("C2:E7")
Set rngFilter = Range("A10:A11")
For Each rngCell In rngInput
If Not rngFilter.Find(what:=rngCell, LookAt:=xlWhole) Is Nothing Then
rngFilterRow = rngFilter.Find(what:=rngCell, LookAt:=xlWhole).Row
Cells(rngFilterRow, rngCell.Column) = Cells(rngFilterRow, rngCell.Column) & ", " & rngCell.Row
End If
Next
End Sub