Попробуйте, см. Комментарии для более подробной информации:
Option Explicit
Sub concatenateValues()
Dim ws As Worksheet: Set ws = ActiveWorkbook.Sheets("Sheet Name") '
Dim lRow As Long: lRow = ws.Cells(Rows.Count, 2).End(xlUp).Row 'get last row at column B
Dim lCol As Long: lCol = ws.Cells(1, Column.Count).End(xlToLeft).Column 'get last column at row 1, assuming you have at least headers
Dim arrData As Variant: arrData = ws.Range(ws.Cells(1, 1), ws.Cells(lRow, lCol)) 'declare and allocate your data to an array
Dim R As Long, C As Long
For R = LBound(arrData) + 1 To UBound(arrData) 'for each row in your data, start at row 2
For C = LBound(arrData, 2) + 1 To UBound(arrData, 2) 'for each column in your data, start at column 2
arrData(R, 1) = arrData(R, 1) & arrData(R, C) 'concatenate the values
Next C
Next R
ws.Range(ws.Cells(1, 1), ws.Cells(lRow, lCol)) = arrData 'put the values back into the sheet
End Sub