解除後に値を入れる。
Dim r As Range
Set r = Range("G8")
Dim str As String
Dim adr As Variant
Dim c
Do Until r.Offset(, 1).Value = ""
If r.MergeCells = True Then
str = r.Value
adr = r.MergeArea.Address
r.MergeCells = False
For Each c In Range(adr)
c.Value = str
Next
End If
Set r = r.Offset(1)
Loop