[решено] Разъединить ячейку с копированием значения в результирующий набор

[Dirk Diggler]

Есть объединенная ячейка, которую хотелось бы разъединить так, чтобы исходное значение скопировалось во все результирующие ячейки.
Для простоты возьмем, что объединены они только в одном столбце и не более чем по 10 ячеек

Написал макрос:

Sub UnmergeCells()
Dim iROW As Integer, iColumn As Integer, sTMP As String, i As Integer, s As Object

Application.ScreenUpdating = False
s = ActiveCell.Cells
For iROW = 0 To 10
ActiveWorkbook.ActiveSheet.Cells(s.Row + iROW, s.Column).MergeArea.UnMerge
Next iROW

s.Select
'Range("A3").Select
iROW = 1
Do While Not IsEmpty(ActiveCell)
i = iROW - 1
If ActiveCell.Offset(iROW, 0).Value = "" Then
ActiveCell.Offset(iROW, 0).Value = s.Value
End If
iROW = iROW + 1
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Ругается object variable or with block variable not set
Где ошибся? Может, у кого готовое решение есть, задача-то известная...

[Dirk Diggler]

Пардон, сам разобрался. Конечный вариант(разъединяет текущую ячейку вниз)

Sub UNM()
Dim iROW As Integer, iColumn As Integer, sTMP As String, i As Integer, s As Range
Application.ScreenUpdating = False
Set s = ActiveCell
If ActiveWorkbook.ActiveSheet.Cells(s.Row + iROW, s.Column).MergeCells Then
i = ActiveWorkbook.ActiveSheet.Cells(s.Row + iROW, s.Column).MergeArea.Count - 1
ActiveWorkbook.ActiveSheet.Cells(s.Row + iROW, s.Column).MergeArea.UnMerge
End If
s.Select
ActiveCell.Offset(1, 0).Select
Do While IsEmpty(ActiveCell) And i > 0
i = i - 1
ActiveCell.Value = s.Value
ActiveCell.Offset(1, 0).Select
Loop
End Sub

[Pliomera]

Да уж. Гвозди забивать микроскопом. Циклы, объекты, куча переменных....

Решение:

Sub UNM2()
ActiveCell.MergeArea.UnMerge
Selection.Value = ActiveCell
End Sub

Всё.