Excel

Sub UnMerge_And_Fill_By_Value() ' разгруппировать все ячейки в Selection и ячейки каждой бывшей группы заполнить значениями из их первых ячеек
     Dim Address As String
     Dim Cell As Range
 
     If TypeName(Selection) <> "Range" Then
         Exit Sub
     End If
 
     If Selection.Cells.Count = 1 Then
         Exit Sub
     End If
 
     Application.ScreenUpdating =  False
 
     For Each Cell In Intersect(Selection, ActiveSheet.UsedRange).Cells
         If Cell.MergeCells Then
             Address = Cell.MergeArea.Address
             Cell.UnMerge
             Range(Address).Value = Cell.Value
         End If
     Next
End Sub