Rows to Column - Macro

[wardex]

Hi guys, can you help me. I need a macro for this problem. Thanks in advance!

 

[Zot]

Try this

Sub Arrange()

Dim mA As Long, nA As Long, mB As Long, nB As Long, idx As Long
Dim eRow As Long, eCol As Long
Dim LastCell As Range
Dim wsA As Worksheet, wsB As Worksheet

Set wsA = ActiveWorkbook.Sheets("Sheet1")
Set wsB = ActiveWorkbook.Sheets("Sheet2")
Set LastCell = wsA.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)

eRow = LastCell.Row
eCol = LastCell.Column

For mA = 1 To eRow
    If Not wsA.Cells(mA, 1) = 0 Then
        idx = wsA.Cells(mA, 1)
        nB = 0
    End If
    For nA = 1 To eCol
        If Not mB = idx Then mB = mB + 1
        If Not Len(wsA.Cells(mA, nA)) = 0 Then
            If mB = idx Then nB = nB + 1
            wsB.Cells(mB, nB) = wsA.Cells(mA, nA)
        End If
    Next
Next

End Sub

 

[wardex]

Try this

Sub Arrange()

Dim mA As Long, nA As Long, mB As Long, nB As Long, idx As Long
Dim eRow As Long, eCol As Long
Dim LastCell As Range
Dim wsA As Worksheet, wsB As Worksheet

Set wsA = ActiveWorkbook.Sheets("Sheet1")
Set wsB = ActiveWorkbook.Sheets("Sheet2")
Set LastCell = wsA.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)

eRow = LastCell.Row
eCol = LastCell.Column

For mA = 1 To eRow
    If Not wsA.Cells(mA, 1) = 0 Then
        idx = wsA.Cells(mA, 1)
        nB = 0
    End If
    For nA = 1 To eCol
        If Not mB = idx Then mB = mB + 1
        If Not Len(wsA.Cells(mA, nA)) = 0 Then
            If mB = idx Then nB = nB + 1
            wsB.Cells(mB, nB) = wsA.Cells(mA, nA)
        End If
    Next
Next

End Sub

thanks for the help sir. An error prompt after running the given code.

 

[Zot]

thanks for the help sir. An error prompt after running the given code.

It ran just fine on my PC. I'm still on Excel 2016 but it should not be a problem I suppose.

If it stuck there, does this mean you have yet to have anything written in Sheet2?

 

[Zot]

I see that you run code before I modified
Line
Dim RowA As Long, RowB As Long, ColA As Long, ColB As Long
is not required because not used but that will not cause the problem.

 

[wardex]

Sheet2 is empty sir. I created a new sheet and renamed it to Sheet2

 

[Zot]

Sheet2 is empty sir. I created a new sheet and renamed it to Sheet2

the code is designed for data in Sheet1 start on column 1 row 1.

 

[Zot]

My Sheet1

Book1
	A	B	C	D	E
1	1	a	b	c	d
2		e	f	g	h
3		i	j	k	l
4	2	aa	bb	cc	dd
5		ee	ff	gg	hh
6	3	aaa	bbb	ccc	ddd
7		eee	fff	ggg	hhh
8		iii	jjj	kkk	lll
9		mmm	nnn	ooo	ppp
Sheet1

My Sheet2

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	1	a	b	c	d	e	f	g	h	i	j	k	l
2	2	aa	bb	cc	dd	ee	ff	gg	hh
3	3	aaa	bbb	ccc	ddd	eee	fff	ggg	hhh	iii	jjj	kkk	lll	mmm	nnn	ooo	ppp
4
Sheet2

 

[Zot]

Try create a new workbook with Sheet1 and Sheet2 and run the code again

 

[wardex]

Sir I got it )

Just figured out that if you rename the new added sheet it will, but in the VBA it will not change at all.

Thanks again! God bless!