Sub breakmydata()
Dim lrow As Long
Dim cell As Range, rng As Range
Dim i As Long, str As String
Dim k As Long
lrow = Cells(Cells.Rows.Count, "a").End(xlUp).Row
Set rng = Range("A2:A" & lrow)
k = 2
For Each cell In rng
For i = 1 To Len(cell.Offset(0, 1).Value)
Cells(k, "D").Value = cell.Value
If Asc(Mid(cell.Offset(0, 1).Value, i, 1)) = 13 Or i = Len(cell.Offset(0, 1).Value) Then
Cells(k, "e").NumberFormat = "@"
If i = Len(cell.Offset(0, 1).Value) Then
Cells(k, "e").Value = str & Mid(cell.Offset(0, 1).Value, i, 1)
Else
Cells(k, "e").Value = str
End If
k = k + 1
str = ""
Else
If str = "" Then
str = Mid(cell.Offset(0, 1).Value, i, 1)
Else
str = str & Mid(cell.Offset(0, 1).Value, i, 1)
End If
End If
Next i
Next cell
End Sub
Sub breakmydata()
Dim lrow As Long
Dim cell As Range, rng As Range
Dim i As Long, str As String
Dim k As Long
lrow = Cells(Cells.Rows.Count, "a").End(xlUp).Row
Set rng = Range("A2:A" & lrow)
k = 2
For Each cell In rng
For i = 1 To Len(cell.Offset(0, 1).Value)
Cells(k, "D").Value = cell.Value
If Asc(Mid(cell.Offset(0, 1).Value, i, 1)) = 13 Or i = Len(cell.Offset(0, 1).Value) Then
Cells(k, "e").NumberFormat = "@"
If i = Len(cell.Offset(0, 1).Value) Then
Cells(k, "e").Value = str & Mid(cell.Offset(0, 1).Value, i, 1)
Else
Cells(k, "e").Value = Trim(Replace(str, Chr(10), ""))
End If
k = k + 1
str = ""
Else
If str = "" Then
str = Mid(cell.Offset(0, 1).Value, i, 1)
Else
str = str & Mid(cell.Offset(0, 1).Value, i, 1)
End If
End If
Next i
Next cell
End Sub