Take a look here:

  http://www.mcgimpsey.com/excel/mergedata.html

Zemo

Sub ConCat_Cells()
Dim x As Range
Dim y As Range
Dim z As Range
Dim w As String
Dim sbuf As String
   On Error GoTo endit
   w = InputBox("Enter the Type of De-limiter If Desired")
   Set z = Application.InputBox("Select Destination Cell", _
           "Destination Cell", , , , , , 8)
   Application.SendKeys "+{F8}"
   Set x = Application.InputBox _
   ("Select Cells...Contiguous or Non-Contiguous", _
           "Cells Selection", , , , , , 8)
   For Each y In x
       If Len(y.text) > 0 Then sbuf = sbuf & y.text & w
   Next
   z = Left(sbuf, Len(sbuf) - 1)
   Exit Sub
endit:
   MsgBox "Nothing Selected.  Please try again."
End Sub

Gord Dibben Excel MVP