there are blank rows in your table.
Sub Combine_Cells_ColB_thru_ColAA_in_ColumnA()
Dim LastRow As Long, LastCol As Long
Dim i As Long, j As Long, Calc As Long
With Application
.ScreenUpdating = False
.DisplayAlerts = False
Calc = .Calculation
.Calculation = xlCalculationManual
End With
With ActiveSheet
.Columns("A").Clear
LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
LastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
For i = 1 To LastRow
For j = 2 To LastCol
If .Cells(i, j).Value <> "" Then
.Cells(i, 1).Value = Mid(.Cells(i, 1).Value & ", " & .Cells(i, j).Value, 3)
End If
Next j
Next i
End With
With Application
.Calculation = Calc
End With
End Sub