[vba]
Sub Test()
Dim lLastRow As Long
Dim lRow As Long
Dim lLastCol As Long
Dim lCol As Long
Dim Cell As Range
Dim sTemp As String
lLastRow = Sheet1.UsedRange.Rows.Count
lLastCol = Sheet1.UsedRange.Columns.Count
For lRow = 2 To lLastRow
sTemp = Cells(lRow, "B")
For lCol = 3 To lLastCol
If Cells(lRow, lCol) = vbNullString Then
Exit For
Else
sTemp = sTemp & Chr(10) & Cells(lRow, lCol)
End If
Next lCol
Cells(lRow, "B") = sTemp
Next lRow
Range(Cells(1, "C"), Cells(1, lLastCol)).EntireColumn.Delete
End Sub