Sub äàòà_1()
Dim iCell As Range
Dim iUnionrange As Range
n = [F2].Value
    For Each iCell In Range("A1:A50"    
        If iCell = n Then
        If iUnionrange Is Nothing Then
        Set iUnionrange = Union(iCell, iCell)
        Else
        Set iUnionrange = Union(iUnionrange, iCell)
        End If
        End If
    Next
If Not iUnionrange Is Nothing Then iUnionrange.Offset(0, 1).Select

Const sdelim As String = " "
Dim rcell As Range
Dim smergestr As String
With Selection
    For Each rcell In .Cells
        smergestr = smergestr & sdelim & rcell.Text
    Next rcell
Application.DisplayAlerts = False
.Merge across:=False
.Item(1).Value = Mid(smergestr, 1 + Len(sdelim))
End With
End Sub