Sub JoinRows()
  'David McRitchie  2003-06-16 programming, documented in
  '  http://www.mvps.org/dmcritchie/excel/join.htm
  'Join cells with CHAR(10) to cell above within selection
  Dim iCols As Long, mRow As Long, lastcell As Range
  Dim iAnswer As Variant, l As Long, im As Long
  Dim ic As Long, ir As Long, iRows As Long, trimmed As String
  Dim response As Long
  If Selection.Columns.Count <> Cells.Columns.Count Then
     response = MsgBox("You did not select entire rows" & Chr(10) _
       & "Press OK to continue anyway (rows may not line up)" _
       & Chr(10) & "Press Cancel to terminate", vbOKCancel)
     If response = vbCancel Then Exit Sub
  End If
  Application.ScreenUpdating = False
  On Error Resume Next
  iRows = Selection.Rows.Count
  Set lastcell = Cells.SpecialCells(xlLastCell)
  mRow = lastcell.Row
  If mRow < iRows Then iRows = mRow 'not best but better than nothing
  iCols = Selection.Columns.Count
  For ir = iRows To 2 Step -1
     For ic = 1 To iCols
       If Trim(Selection.Item(ir, ic).Value) <> "" Then
          If Trim(Selection.Item(ir - 1, ic).Value) <> "" Then
             Selection.Item(ir - 1, ic).Value = Selection.Item(ir - 1, ic) _
                 & Chr(10) & Selection.Item(ir, ic)
          Else
             Selection.Item(ir - 1, ic).Value = Selection.Item(ir, ic)
          End If
       End If
    Next ic
    Selection.Item(ir, 1).Resize(1, iCols).Delete
  Next ir
  Selection.Resize(1).Select
  With Selection
    .VerticalAlignment = xlTop
    .WrapText = True
  End With
  Application.ScreenUpdating = True
End Sub