Попробуйте это.
Sub Test()
Dim vDB, vS, vR(), vHead()
Dim Ws As Worksheet
Dim n As Long, i As Long, j As Integer
Dim r As Long, c As Integer, k As Integer
Dim a As Integer, cnt As Integer
Set Ws = ActiveSheet
Ws.Cells.Replace ".", ""
Ws.Cells.Replace ",", ""
vDB = Ws.UsedRange
r = UBound(vDB, 1)
c = UBound(vDB, 2)
'@@ get colum's number of data
For i = 1 To c
If vDB(2, i) <> "" Then
k = k + 1
ReDim Preserve vHead(1 To k)
vHead(k) = i
End If
Next i
n = 0
'@@ Cycle the cell to see if chr(10) (vbNewline) is included.
For i = 1 To r
If InStr(vDB(i, 1), Chr(10)) Then '~~> if includ chr(10)
vS = Split(vDB(i, 1), Chr(10))
cnt = UBound(vS)
For a = 0 To cnt
n = n + 1
ReDim Preserve vR(1 To c, 1 To n)
For j = 1 To k
vS = Split(vDB(i, vHead(j)), Chr(10))
If j = 1 Then
vR(vHead(j), n) = Split(vS(a))(0)
Else
vR(vHead(j), n) = Val(Trim(vS(a)))
End If
Next j
Next a
Else '~~> if don't include chr(10)
n = n + 1
ReDim Preserve vR(1 To c, 1 To n)
vR(1, n) = vDB(i, 1)
End If
Next i
Sheets.Add
Range("a1").Resize(n, c) = WorksheetFunction.Transpose(vR)
Range("J:O").NumberFormatLocal = "#,###"
End Sub