أخى الفاضل
جربت الكود وهو يعمل بشكل سليم
وقد أضفت إليه إضافة بسيطة
Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant
LR = Cells(Rows.Count, 1).End(xlUp).Row
Set CompareRange = Range("a2:a" & LR)
For Each x In Selection
For Each y In CompareRange
If UCase(x) = UCase(y) Then x.Offset(0, 3) = x
Next y
Next x
End Sub
وإن كنت تقصد الجملة الأولى
فى العمود الأول OULD BASTAMI AMEUR
وفى العمود الثانى OULD BESTAMI Ameur
وبالتالى فهى مختلفة فى حرف واحد