Hi tuongtu3,
Option Explicit
Sub Macro1()
'Written by Trebor76
'Visit my website www.excelguru.net.au
'Split multiple cell items based on a comma
'http://www.excelforum.com/excel-programming-vba-macros/954682-find-text-string-after-the-then-move-its-down-to-the-last-row.html
Dim rngCell As Range
Dim intCellPos As Integer
Dim strMyText As String
Dim lngMyRow As Long
Application.ScreenUpdating = False
For Each rngCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
If InStr(rngCell, ",") > 0 Then
For intCellPos = 1 To Len(rngCell)
If Mid(rngCell, intCellPos, 1) <> " " Then
If Mid(rngCell, intCellPos, 1) <> "," Then
strMyText = strMyText & Mid(rngCell, intCellPos, 1)
Else
Cells(Range("G" & Rows.Count).End(xlUp).Row + 1, "G") = strMyText
strMyText = ""
End If
End If
Next intCellPos
If strMyText <> "" Then
Cells(Range("G" & Rows.Count).End(xlUp).Row + 1, "G") = strMyText
strMyText = ""
End If
Else
Cells(Range("G" & Rows.Count).End(xlUp).Row + 1, "G") = rngCell
End If
Next rngCell
Application.ScreenUpdating = True
MsgBox "Done!!", vbInformation
End Sub
HTH
Robert
Bookmarks