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

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Microsoft Office (Word, Excel, Outlook и т.д.) (http://forum.oszone.net/forumdisplay.php?f=115)

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

Есть объединенная ячейка, которую хотелось бы разъединить так, чтобы исходное значение скопировалось во все результирующие ячейки.
Для простоты возьмем, что объединены они только в одном столбце и не более чем по 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
Где ошибся? Может, у кого готовое решение есть, задача-то известная...

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

Код:

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

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

Решение:

Код:

Sub UNM2()

ActiveCell.MergeArea.UnMerge

Selection.Value = ActiveCell

End Sub

Всё.