Konrad

Code follows. Work out bugs yourself.

To use it, mark your range and run the macro.

Public Sub MergeMarked()
Dim lStart As Long, lEnd As Long
Dim strLastMark As String, strMark As String
Dim rSelected As Range

Set rSelected = Selection
lStart = 1
strLastMark = rSelected.Cells(1, rSelected.Columns.Count).Value
While lStart < rSelected.Rows.Count
lEnd = lStart
While strLastMark = rSelected.Cells(lEnd,
rSelected.Columns.Count).Value And _
rSelected.Cells(lEnd, rSelected.Columns.Count).Value < ""
If rSelected.Cells(lEnd, rSelected.Columns.Count).Value =
"" Then
GoTo AllDone
End If
lEnd = lEnd + 1
Wend
If lEnd lStart Then
rSelected.Range(Cells(lStart + 1, rSelected.Columns.Count -
1), Cells(lEnd, rSelected.Columns.Count)).Clear
rSelected.Cells(lStart + 1, rSelected.Columns.Count -
1).Value = strLastMark
rSelected.Range(Cells(lStart + 1, rSelected.Columns.Count -
1), Cells(lEnd, rSelected.Columns.Count)).Merge
rSelected.Cells(lStart + 1, rSelected.Columns.Count -
1).HorizontalAlignment = xlHAlignCenter
rSelected.Cells(lStart + 1, rSelected.Columns.Count -
1).VerticalAlignment = xlVAlignCenter
lStart = lEnd
End If
lStart = lStart + 1
strLastMark = rSelected.Cells(lStart,
rSelected.Columns.Count).Value
Wend

AllDone:

End Sub