Согласно нашему обсуждению в комментариях, вот макрос, который я думаю, должен достигнуть того, что Вы после. Очевидно, протестируйте его на скопированных данных сначала в случае, если что-то плохо происходит.

Надо надеяться, единственная вещь, которую необходимо будет скорректировать, colToMerge постоянный около вершины, для соответствия, какой бы ни столбец данные для слияния, оказывается, находится в.

Править

Я только что определил Excel 2007 в Вашем заголовке вопроса, так обратите внимание на то, что я записал это в 2003.
Надо надеяться, это должно все еще работать, потому что это только делает очень простое перемещение и управление значением ячейки. Сообщите мне, не делает ли это, и я скорректирую его для Excel 2007, после того как я дома этим вечером.

Код

Sub MergeEmploymentCol()

    'PARAMETER: The column number you are merging. A=0,B=1,etc
    Const colToMerge = 2

    'First unmerge everything
    Cells.UnMerge

    'Select First "valid" row, done manually incase top rows are packed together
    Range("A1").Select
    Do While ActiveCell.Value <> 0
        ActiveCell.Offset(1, 0).Select
    Loop
    ActiveCell.Offset(-1, 0).Select

    'Some variables        
    Dim thisRow As Integer, nextRow As Integer, i As Integer

    Do While ActiveCell.Value <> 0
        'Only need to merge if next row is blank
        If (ActiveCell.Offset(1, 0).Value = 0) Then

            'Get the row numbers for this valid row and the next valid row
            thisRow = ActiveCell.Row

            Selection.End(xlDown).Select
            If (ActiveCell.Value <> 0) Then
                nextRow = ActiveCell.Row
            Else
                'must be last row - no valid rows below this one
                'special handling to find correct row
                ActiveCell.Offset(0, colToMerge).Select
                Selection.End(xlUp).Select
                nextRow = ActiveCell.Row + 1
                ActiveCell.Offset(0, -colToMerge).Select

                'Exit if this last valid row has no duplicates
                If (thisRow + 1 = nextRow) Then
                    Exit For
                End If
            End If
            Selection.End(xlUp).Select

            'Merge the data between here and the next valid row
            Dim combinedData As String
            combinedData = ""
            For i = 0 To (nextRow - thisRow) - 1
                combinedData = combinedData & ActiveCell.Offset(i, colToMerge).Value & Chr(10)
            Next i

            'Trim last (unnecessary) line-return
            combinedData = Mid(combinedData, 1, Len(combinedData) - 1)

            'Place data in cell
            ActiveCell.Offset(0, colToMerge).Value = combinedData

            'Delete unneeded rows
            ActiveCell.Offset(1, 0).Rows("1:" & nextRow - thisRow - 1).EntireRow.Select
            ActiveCell.Offset(0, 0).Range("A1").Activate
            Selection.Delete Shift:=xlUp

            'Select first cell of next valid row
            ActiveCell.Offset(0, 0).Select
        Else
            'Next row not blank, so no need to merge
            'Simple step down to next row
            ActiveCell.Offset(1, 0).Select
        End If

    Loop

End Sub