Split String Loop Email Address Separet A New Row [closed]

Question

I am trying to split a string and create a loop for going through the Cell I Want Only This Code Results Column Wise I want A Row Wise Insert Row And Paste Array 2

Option Explicit

Sub SplitStringLoop()    
    Dim txt As String
    Dim i As Integer
    Dim y As Integer
    Dim FullName As Variant
    Dim LastRow As Single

    ReDim FullName(3)

    LastRow = Cells(Rows.Count, "A").End(xlUp).Row

    For y = 2 To LastRow
        Cells(y, 1).Select
        txt = ActiveCell.Value
        FullName = Split(txt, ",")
        For i = 0 To UBound(FullName)
           Cells(y, i + 2).Value = FullName(i)
        Next i
    Next
End Sub

input output required

Answer 1

You can take all data into array and then split each index and paste it vertically with a counter. In column C is the expected output:

Sub test()
Dim i As Long, j As Long, k As Long
Dim vData As Variant
Dim vArray As Variant

vData = Range("A1").CurrentRegion.Value

k = 2 'starting row where you want to paste final data
For i = 1 To UBound(vData) Step 1
    vArray = Split(vData(i, 1), ",")
    For j = LBound(vArray) To UBound(vArray) Step 1
        Range("C" & k).Value = vArray(j) 'pasting into column C, change it to your needs
        k = k + 1
    Next j
    
    Erase vArray
Next i

Erase vData

End Sub