Поиск выбранных значений в колонке и запись значения из соседней колонки

нашел вот такой макрос на просторах интернета

Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant
' Установка переменной CompareRangeравной сравниваемому диапазону
Set CompareRange = Range("D1:D100")

' Сравнение каждого элемента в выделенном диапазоне с каждым элементом
' переменной CompareRange
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = x
Next y
Next x
End Sub

Она сравнивает выбранный диапазон значений со значениями в столбце D, и записывает его в столбец B.

Как поправить код так чтобы макрос записывал значения из соседнего найденного значения? Приложу картинку для наглядности