Transpose equal segments of rows into piled columns

[occitan]

Hello everybody!

I woud kindly like to ask you a question on transposing segments of rows into piled columns. I looked for similar cases on the forum but I didn't find any :/

Many thanks to whoever would like to help me!

So, I have to create a macro which enables to transpose different (equal) segments of rows into columns in this particular fashion:


A1 A1 A1 A1 B1 B1 B1 B1 C1 C1 C1 C1 D1 D1 D1 D1 E1 E1 E1 E1 ... (first row)
A2 A2 A2 A2 B2 B2 B2 B2 C2 C2 C2 C2 D2 D2 D2 D2 E2 E2 E2 E2 ... (second row)
A3 A3 A3 A3 B3 B3 B3 B3 C3 C3 C3 C3 D3 D3 D3 D3 E3 E3 E3 E3 ... (third row)
...

Into:

A1 B1 C1 D1 E1 ...
A1 B1 C1 D1 E1 ...
A1 B1 C1 D1 E1 ...
A1 B1 C1 D1 E1 ...
A2 B2 C2 D2 E2 ...
A2 B2 C2 D2 E2 ...
A2 B2 C2 D2 E2 ...
A2 B2 C2 D2 E2 ...
A3 B3 C3 D3 E3 ...
A3 B3 C3 D3 E3 ...
A3 B3 C3 D3 E3 ...
A3 B3 C3 D3 E3 ...
... ... ... ... ... ...


I simplified this example, in order to make it clear. In this example, each row consists of 5 elements (A, B, C, D, E -cell values-) which are taken in a group of 4, and have to be transposed into piled columns. In my case, I have 14 elements in each row paired in groups of 133 (instead of 4 in this example).

I tried several attempts in writing macros but I didn't manage to obtain this :/ Also, as I said, I wasn't able to find a solution already existing in the forum.

Many thanks to whoever will be so kind to help me.

O

 

[occitan]

It worked!!!!!!!!!!

THANK YOU SO MUCH FLUFF!!!!!!!!

I owe you a lot!

Many many many many thanks!!!!!!!!!!!!!!

O.

Ok, try this

Sub Trans()

    Dim Cols As Long
    Dim Rws As Long
    Dim clmn As Long
    
    clmn = 2
    For Cols = 1 To 1862 Step 133
        For Rws = 1 To Range("A" & Rows.Count).End(xlUp).Row
            Sheets("sheet3").Cells(Rows.Count, clmn).End(xlUp).Offset(1).Resize(133).Value = Application.Transpose(Cells(Rws, Cols).Resize(, 133).Value)
        Next Rws
        clmn = clmn + 1
    Next Cols
    With Sheets("Sheet3")
        .Rows(1).Delete
        .Range("A1").Value = 1
        .Range("A1").AutoFill .Range("A1:A132867"), xlFillSeries
    End With

End Sub

 

[Fluff]

Glad to help & thanks for the feedback