Transpose the row data of a single cell into different cells in column

[Lekha mohanty]

I have existing data is like this in column A & B with commas

Book2
	A	B
1	1	68,69,70,71,72
2	2	79,80,81,82,83,
3	3	90,91,92,93,94
4	4	102,103,104,105,106,
5	5	125, 236, 237, 238, 239
6	6	170, 171, 172,173,174
7	7	182,230, 231,232,247
8	8	100,101,246 ,254
9	9	1,11,12,13,14, 15
10	10	2,3,4,5,6,7, 8
11	11	27,29,30,32, 33
12	12	100,101,246 ,255
13	13	125, 236, 237, 238, 240
14	14	170, 171, 172,173,175
15	15	182,230, 231,232,248
16	16	100,101,246 ,255
17	17	1,11,12,13,14, 16
18	18	2,3,4,5,6,7, 9
19	19	27,29,30,32, 34
20	20	100,101,246 ,256
21	21	125, 236, 237, 238, 241
22	22	170, 171, 172,173,176
23	23	182,230, 231,232,249
24	24	100,101,246 ,256
25	25	1,11,12,13,14, 17
Sheet2

I want to transpose the data into like this from column C onwards without the commas

Book2
	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA
1	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25
2	68	79
3	69	80
4	70	81
5	71	82
6	72	83
7
8
9
10
11
12
13
Sheet2

 

[Peter_SSs]

Assuming free columns off to the right, try this with a copy of your workbook.

Sub Split_Transpose()
  Application.ScreenUpdating = False
  With Range("A1", Range("B" & Rows.Count).End(xlUp))
    .Offset(, .Rows.Count + 5).Value = .Value
    .Offset(, .Rows.Count + 6).Resize(, 1).TextToColumns DataType:=xlDelimited, Comma:=True, Space:=False, Other:=False
    .Offset(, .Rows.Count + 5).CurrentRegion.Copy
    .Cells(1, 3).PasteSpecial Transpose:=True
    .Offset(, .Rows.Count + 5).CurrentRegion.ClearContents
  End With
  Application.ScreenUpdating = True
End Sub

 

[Lekha mohanty]

Assuming free columns off to the right, try this with a copy of your workbook.

Sub Split_Transpose()
  Application.ScreenUpdating = False
  With Range("A1", Range("B" & Rows.Count).End(xlUp))
    .Offset(, .Rows.Count + 5).Value = .Value
    .Offset(, .Rows.Count + 6).Resize(, 1).TextToColumns DataType:=xlDelimited, Comma:=True, Space:=False, Other:=False
    .Offset(, .Rows.Count + 5).CurrentRegion.Copy
    .Cells(1, 3).PasteSpecial Transpose:=True
    .Offset(, .Rows.Count + 5).CurrentRegion.ClearContents
  End With
  Application.ScreenUpdating = True
End Sub

Thank you

 

[Peter_SSs]

Cheers. No problem.