Please need help with Transpose,offset,loop -Specially the loop-

[frankyalta]

Hi Friends,

I have a VBA code that transpose the Column A and B, (everything perfect), But now i'm adding more columns and i need to do the same Transpose but with offset 1 but my code not have a Loop till the last empty column.

Can someone tell me where can i insert the Loop in my code?

This is the code that i'm using

Public Sub testTranspose()    Dim x As Long
    Dim first_row As Long
    Dim last_row As Long
             
    first_row = 3
    last_row = Range("A" & Rows.Count).End(xlUp).Row
     
    For x = first_row To (last_row) Step 13
        Range("A" & x).Resize(13, 2).Copy
        Range("M" & Rows.Count).End(xlUp).Offset(2).PasteSpecial Transpose:=True
    Next
     
End Sub

THANK YOU !!!!!!!

This is my desire output, see picture :

Excel 2007

	A	B	C	D	E	F	G	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
1	MyData							Heading		Please I need to Transpose my data as sample bellow
2
3	Col-A	Col-B	Col-C	Col-D	Col-E	Col-F
4	A	1	N	14	BB	27		Col-A	A	B	C	D	E	F	G	H	I	J	K	L	M
5	B	2	O	15	CC	28		Col-B	1	2	3	4	5	6	7	8	9	10	11	12	13
6	C	3	P	16	DD	29
7	D	4	Q	17	EE	30		Col-C	N	O	P	Q	R	S	T	V	W	Z	Y	X	AA
8	E	5	R	18	FF	31		Col-D	14	15	16	17	18	19	20	21	22	23	24	25	26
9	F	6	S	19	GG	32
10	G	7	T	20	HH	33		Col-E	BB	CC	DD	EE	FF	GG	HH	II	JJ	KK	LL	MM	NN
11	H	8	V	21	II	34		Col-F	27	28	29	30	31	32	33	34	35	36	37	38	39
12	I	9	W	22	JJ	35
13	J	10	Z	23	KK	36
14	K	11	Y	24	LL	37
15	L	12	X	25	MM	38
16	M	13	AA	26	NN	39
17
18
19
20
21

<tbody>
</tbody>

Sheet2​

 

[Tetra201]

See if this works for you:

Sub testTranspose2()
    Dim first_row As Long, last_row As Long, first_col As Long, last_col As Long, i As Long
    first_row = 3
    first_col = 1
    last_row = Cells(Rows.Count, first_col).End(xlUp).Row
    last_col = Cells(first_row, first_col).End(xlToRight).Column
    Application.ScreenUpdating = False
    For i = 0 To last_col - 1 Step 2
        Range(Cells(first_row, first_col), Cells(last_row, first_col)).Offset(, i).Resize(, 2).Copy
        Range("L" & first_row + 1 + i * 1.5).PasteSpecial Transpose:=True
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[frankyalta]

Hi Tetra201,


It work perfect!!, I tough that i just need to add an snippet in my code, i was wrong...

Thank you !!

 

[frankyalta]

Tetra201,

How do i mark the tread as "SOLVED" ??

Thanks !

 

[Tetra201]

You are most welcome.

To my knowledge, no such tool is available on this forum.