VBA for transposing a "6 column undefined row table" to only 1 column

[Jason56]

I have a 6 column table with a variable rows (B2 to G? of sheet 2).

11	36	37	38	39	45
2	14	15	21	29	46
7	16	18	43	45	48
16	17	27	40	41	45
..	..	..	..	..	..

I want to transpose all cells into only a single column (for example column A of sheet 4)

11
36
37
38
39
45
2
14
15
21 .. .. .. ..

Could you please help me to have a VBA macro for that?

Thanks.

 

[steve the fish]

Try:

Dim lr As Long, arrData, arrRes(), i As Long, j As Long, a As Long

Sheets("Sheet4").Columns(1).ClearContents
With Sheets("Sheet2")
    lr = .Range("B" & .Rows.Count).End(xlUp).Row
    If lr > 1 Then
        arr = .Range("B2:G" & lr)
        ReDim arrRes(1 To 6 * (lr - 1))
        For i = LBound(arr, 1) To UBound(arr, 1)
            For j = LBound(arr, 2) To UBound(arr, 2)
                a = a + 1
                arrRes(a) = arr(i, j)
            Next
        Next
        Sheets("Sheet4").Range("A1").Resize(UBound(arrRes)) = Application.Transpose(arrRes)
    End If
End With

 

[lrobbo314]

Can also do it with dynamic array formulas.

NumberGame.xlsm
	A	B	C	D	E	F	G	H
1	11	36	37	38	39	45		11
2	2	14	15	21	29	46		36
3	7	16	18	43	45	48		37
4	16	17	27	40	41	45		38
5								39
6								45
7								2
8								14
9								15
10								21
11								29
12								46
13								7
14								16
15								18
16								43
17								45
18								48
19								16
20								17
21								27
22								40
23								41
24								45
Sheet9

Cell Formulas
Range	Formula
H1:H24	H1	=LET(tbl,A1:F4,c,COLUMNS(tbl),seq,SEQUENCE(c*ROWS(tbl),,0),INDEX(tbl,seq/c+1,MOD(seq,c)+1))
Dynamic array formulas.

 

[Jason56]

Try:

Dim lr As Long, arrData, arrRes(), i As Long, j As Long, a As Long

Sheets("Sheet4").Columns(1).ClearContents
With Sheets("Sheet2")
    lr = .Range("B" & .Rows.Count).End(xlUp).Row
    If lr > 1 Then
        arr = .Range("B2:G" & lr)
        ReDim arrRes(1 To 6 * (lr - 1))
        For i = LBound(arr, 1) To UBound(arr, 1)
            For j = LBound(arr, 2) To UBound(arr, 2)
                a = a + 1
                arrRes(a) = arr(i, j)
            Next
        Next
        Sheets("Sheet4").Range("A1").Resize(UBound(arrRes)) = Application.Transpose(arrRes)
    End If
End With

Thank you soo much

 

[Jason56]

Can also do it with dynamic array formulas.

NumberGame.xlsm
	A	B	C	D	E	F	G	H
1	11	36	37	38	39	45		11
2	2	14	15	21	29	46		36
3	7	16	18	43	45	48		37
4	16	17	27	40	41	45		38
5								39
6								45
7								2
8								14
9								15
10								21
11								29
12								46
13								7
14								16
15								18
16								43
17								45
18								48
19								16
20								17
21								27
22								40
23								41
24								45
Sheet9

Cell Formulas
Range	Formula
H1:H24	H1	=LET(tbl,A1:F4,c,COLUMNS(tbl),seq,SEQUENCE(c*ROWS(tbl),,0),INDEX(tbl,seq/c+1,MOD(seq,c)+1))
Dynamic array formulas.

Thank you