Макросом выделить нужный диапазон и  
Selection.UnMerge

Тыкаем в объединенную ячейку и запускаем макрос:  
Sub Макрос1()  
a = Selection.Value  
Selection.UnMerge  
For Each rr In Selection  
rr.Value = a  
Next  
End Sub  
 
 
СердЖиГ, у Вас только один столбец заполняеется

СердЖиГ, просто проверить ведь этот код :)

А ведь тема-то интересная, часто нужная и так и не доведенная до ума...  
Вот есть, например, таблица - штатное расписание организации (ну, или табличное описание чего угодно, имеющего иерархическую структуру) составленное с использованием объединенных ячеек. Естественно, что из-за наличия объединенных ячеек такую таблицу нормально фильтровать будет невозможно, а уж о том, чтобы перенести информацию в базу данных даже и подумать страшно...  
Макрос типа:  
 
Sub UnMerge_And_Fill_All()  
  Dim MainValue  
  Dim iCell As Range  
  MainValue = Selection.Value  
  Selection.UnMerge  
  For Each iCell In Selection  
     iCell.Value = MainValue  
  Next  
End Sub  
 
при выделении по очереди каждой из объединенных ячеек всё делает правильно.  
Но если выделить диапазон, содержащий несколько групп объединенных ячеек, то после разъединения все ячейки выделенного диапазона окажутся заполнены значением MainValue.  
А надо сделать чтобы в выделенном диапазоне перебирались в цикле все группы объединенных ячеек, каждая группа разгруппировывалась и её ячейкам присваивалось своё значение MainValue  
Алгоритм-то мне ясен, но как сделать, что-то не пойму...  
В приведенном примере на Лист1 в ячейках A1:E40 (в общем случае A:E) показана исходная таблица, а на Лист2 - таблица, как она должна выглядеть после разгруппировки макросом Smart_UnMerge

Что-то у меня не работает...  
Ругается "Недопустимое число аргументов или присвоение значения свойства.  
 
Т.к. после iCell.UnMerge изначальное Selection сбрасывается и выбранными оказываются разгруппированные ячейки, то пришлось его запоминать в дополнительной переменной Sel_0  
 
Сделал так:  
Sub Smart_UnMerge()  
  Dim MainValue  
  Dim iCell As Range  
  Dim iiCell As Range  
  Dim Sel_0  
  Sel_0 = Selection.Range  
  For Each iCell In Sel_0  
     If iCell.MergeCells = True Then  
        MainValue = iCell.Value  
        iCell.UnMerge  
        For Each iiCell In Selection  
           iiCell.Value = MainValue  
        Next  
     End If  
  Next  
End Sub

http://www.planetaexcel.ru/tip.php?aid=86  
для Excel 2007: на ленте выбрать Главная - Найти и выделить - Выделение группы ячеек - пустые ячейки

The_Prist ,  
если выделить целиком несколько столбцов, то разгруппировывает очень долго...  
Надо бы, наверное, как-то ограничить обрабатываемый диапазон "до последней используемой строки".  
А как это сделать?

вот тут "в лёт" не получилось...  
1. Разгруппировываются все ячейки в столбце даже если выбран ограниченный диапазон, а не столбец.  
2. Формула по строкам (сверху вниз) размножается правильно, а по столбцам (слева-направо) - нет. Берет значения из ячейки выше, а не слева...  
Пункт 2 попробую, конечно, сам исправить, но это мне ещё придётся побиться...

на всякий случай если кому-нибудь надо:  
Sub UnMerge_and_Fill_by_Value()  
  '---------------------------------------------------------------------------------------  
  ' Procedure : UnMerge_and_Fill_by_Value  
  ' Author    : The_Prist ( http://www.planetaexcel.ru/forum.php?thread_id=3760&thread_id=3760&page_forum=lastpage&allnum_forum=14#post86381 )  
  ' Date      : 23.12.2009  
  ' Purpose   : Снимает объединение со всех ячеек выделенного диапазона _  
    и заполняет все разгруппированные ячейки каждой бывшей группы значениями верхней левой  
  '---------------------------------------------------------------------------------------  
  Dim sValue As String, sAddress As String  
  Dim rRange As Range, rCell As Range  
  Application.ScreenUpdating = False  
  Set rRange = Range(Cells(Selection.Row, Selection.Column), _  
                     Cells(Cells.SpecialCells(xlLastCell).Row, _  
                           Selection.Column + Selection.Columns.Count - 1))  
  For Each rCell In rRange  
     If rCell.MergeCells = True Then  
        sValue = rCell.Value: sAddress = rCell.MergeArea.Address  
        rCell.UnMerge: Range(sAddress).Value = rCell.Value  
     End If  
  Next  
  Application.ScreenUpdating = True  
End Sub  
 
Sub UnMerge_and_Fill_by_HyperLink()  
  '---------------------------------------------------------------------------------------  
  ' Procedure : UnMerge_and_Fill_by_HyperLink  
  ' Author    : The_Prist ( http://www.planetaexcel.ru/forum.php?thread_id=3760&thread_id=3760&page_forum=lastpage&allnum_forum=14#post86381 )  
  ' Date      : 23.12.2009  
  ' Purpose   : Снимает объединение со всех ячеек выделенного диапазона _  
    и заполняет все разгруппированные ячейки каждой бывшей группы ссылками на значения верхней левой  
  '---------------------------------------------------------------------------------------  
  Dim sAddress As String  
  Dim rRange As Range, rCell As Range, rEmptyRange As Range  
  Dim lLastRow As Long, lLastCol As Long  
  lLastRow = Cells.SpecialCells(xlLastCell).Row  
  lLastCol = Selection.Column + Selection.Columns.Count - 1  
  If lLastRow > Selection.Row + Selection.Rows.Count - 1 Then lLastRow = Selection.Row + Selection.Rows.Count - 1  
  Application.ScreenUpdating = False  
  Set rRange = Range(Cells(Selection.Row, Selection.Column), Cells(lLastRow, lLastCol))  
  For Each rCell In rRange  
     If rCell.MergeCells = True Then  
        sAddress = rCell.MergeArea.Address: rCell.UnMerge  
        On Error Resume Next: Set rEmptyRange = Range(sAddress).SpecialCells(xlCellTypeBlanks)  
        If Not rEmptyRange Is Nothing Then rEmptyRange.Formula = "=" & rCell.Cells(1).Address  
     End If  
  Next  
  Set rRange = Nothing: Set rCell = Nothing: Set rEmptyRange = Nothing  
  Application.ScreenUpdating = True  
End Sub

Разбирался с кучей макросов в своём Personal.xls, немного "причесал" и слепил в один два предыдущих макроса заполнения разгруппированных ячеек:  
Sub UnMerge_and_Fill()  
  '---------------------------------------------------------------------------------------  
  ' Procedure    : UnMerge_and_Fill  
  ' Topic_HEADER : Снятие объединения ячеек с заполнением  
  ' Topic_URL    : http://www.planetaexcel.ru/forum.php?thread_id=3760  
  ' Purpose      : Снимает объединение со всех ячеек выделенного диапазона  
  '                и заполняет все разгруппированные ячейки КАЖДОЙ бывшей группы  
  '                либо ссылками на значения верхней левой, либо её значениями  
  '---------------------------------------------------------------------------------------  
  If Selection.Cells.Count <= 1 Then Exit Sub  
  Dim rRange As Range, rCell As Range, sValue$, sAddress$, i&  
  Application.ScreenUpdating = False  
  Set rRange = Intersect(Selection, ActiveSheet.UsedRange)  
  Select Case MsgBox("""ДА"" - заполнить ячейки формулами-ссылками на первую ячейку" & vbCrLf & _  
                     """НЕТ"" - заполнить ячейки значениями из первой ячейки" & vbCrLf & _  
                     """ОТМЕНА"" не разгруппировывать" _  
                     , vbYesNoCancel + vbQuestion, "Как заполнять ячейки после разгруппировки?")  
     Case vbYes   ' разгруппировать все ячейки в Selection и ячейки каждой бывшей группы заполнить формулами-ссылками на их первые ячейки  
        For Each rCell In rRange  
           If rCell.MergeCells Then  
              sAddress = rCell.MergeArea.Address: rCell.UnMerge  
              For i = 2 To Range(sAddress).Cells.Count  
                 With Range(sAddress)  
                    .Cells(i).Formula = "=" & .Cells(1).Address  
                    .Cells(i).Replace What:="$", Replacement:="", LookAt:=xlPart  ' сделать ссылки перемещаемыми  
                    .Cells(i).Font.ColorIndex = 5   ' сделать шрифт формул синим (это на любителя, конечно)  
                 End With  
              Next i  
           End If  
        Next rCell  
     Case vbNo    ' разгруппировать все ячейки в Selection и ячейки каждой бывшей группы заполнить значениями из их первых ячеек  
        For Each rCell In rRange  
           If rCell.MergeCells Then  
              sAddress = rCell.MergeArea.Address: sValue = rCell.Value: rCell.UnMerge  
              Range(sAddress).Value = rCell.Value  
           End If  
        Next  
     Case vbCancel  
        If MsgBox("Разгруппировать стандартным способом?", vbYesNo + vbQuestion) = vbYes Then Selection.UnMerge  
  End Select  
  rRange.Select  
  Application.ScreenUpdating = True  
End Sub