Unmerge Cells and Fill with Duplicate Values

[snb]

or

Sub snb()
    Cells(1).CurrentRegion.unmerge
    For Each ar In Cells(1).CurrentRegion.Columns(1).SpecialCells(4).Areas
        ar.Value = ar.Cells(1).Offset(-1)
        ar.Offset(, 1) = ar.Offset(, 1).Cells(1).Offset(-1)
    Next
End Sub