Option Explicit
Sub aa()
Dim R As Range
Dim C As Range
Dim FirstC As Range
'---
Set R = ActiveSheet.UsedRange
'---
Set C = R.Cells(1, 1)
Application.FindFormat.MergeCells = True
Do
Set C = R.Find(What:="*", After:=C, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
If C Is Nothing Then Exit Do
If FirstC Is Nothing Then
Set FirstC = C
Else
If C = FirstC Then Exit Do
End If
MsgBox C.MergeArea.Address(False, False)
Loop
End Sub