Sub Tust()
Dim FirstCell As Range, HitCell As Range
With Application.FindFormat
.Clear
.MergeCells = True
End With
Set FirstCell = Cells.Find(What:="", After:=Cells(1, 1), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
If Not FirstCell Is Nothing Then
Dim CurrCell As Range, Rslt As String
Set CurrCell = FirstCell
Do
With CurrCell
If Not Intersect(CurrCell, Columns("A:B")) Is Nothing Then
If .HorizontalAlignment = -4108 Or .HorizontalAlignment = 7 Then
If Not HitCell Is Nothing Then
Set HitCell = Union(HitCell, CurrCell)
Else
Set HitCell = CurrCell
End If
End If
End If
End With
Rslt = Rslt & CurrCell.Address & ","
Set CurrCell = Cells.Find(What:="", After:=CurrCell, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
Loop Until CurrCell.Address = FirstCell.Address
Application.DisplayAlerts = False
With HitCell
.HorizontalAlignment = 1
.UnMerge
End With
Application.DisplayAlerts = True
End If
End Sub