one cell to different rows

[itsgagandeep]

HI,

Plz help me in this

i got data in one cell
1,2,3,4,5

i want to change this data in different rows like ,
1
2
3
4
5


it should be inserted in the new row, not overwrite the current data .

 

[VoG]

Try like this

Sub Splt()
Dim X
With Range("A1")
    X = Split(.Value, ",")
    .Offset(1).Resize(UBound(X) + 1).Value = Application.Transpose(X)
End With
End Sub

 

[itsgagandeep]

thanx for the reply,

its working but it is not inserting new row , it is overwriting the below data.

 

[VoG]

Try

Sub Splt()
Dim X
With Range("A1")
    X = Split(.Value, ",")
    .Offset(1).Resize(UBound(X) + 1).Insert shift:=xlShiftDown
    .Offset(1).Resize(UBound(X) + 1).Value = Application.Transpose(X)
End With
End Sub

 

[itsgagandeep]

its like below,

i got below data,

A1 B1
1]gaga 1,2,3,4
2]vog a,b,c


i want the data in below format

A1 B1
1] gaga 1
2] 2
3] 3
4] 4
5]vog a
6] b
7] c

 

[itsgagandeep]

yes its inserting new row also , thanx
i want to shift whole row not single cell

 

[VoG]

Try

Sub Splt()
Dim X
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 1 Step -1
    With Range("B" & i)
        X = Split(.Value, ",")
        .Offset(1).Resize(UBound(X)).EntireRow.Insert
        .Resize(UBound(X) + 1).Value = Application.Transpose(X)
    End With
Next i
End Sub

 

[itsgagandeep]

thanx a lot , its working now
thanx again

 

[rahulbassi]

But, can i skip this all if there is no value or just one value in the cell for a particular row? i.e. there is no comma.

 

[VoG]

Try

Sub Splt()
Dim X
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 1 Step -1
    With Range("B" & i)
        If .Value <> "" Then
            X = Split(.Value, ",")
            If UBound(X) > 0 Then
                .Offset(1).Resize(UBound(X)).EntireRow.Insert
                .Resize(UBound(X) + 1).Value = Application.Transpose(X)
            End If
        End If
    End With
Next i
End Sub