Macros de transpositions

Bonjour,

J'aurais besoin d'aide pour créer un macro qui pourrait transposer horizontalement une colonne de 7500 chiffres aléatoires

sur 12 colonnes. Au 13 ième chiffre il revient à la première colonne et ainsi de suite. Ce qui donnerait au total un fichier de 12 colonnes par 625 cellules.

Merci de votre aide!

Bonsoir le forum, nicodan

Bonsoir ThauThème

Si j'ai bien compris.

La valeur de la constante Decoupe est fixée à 625

Option Explicit

Sub Transpose()
Dim a, b(), i As Long, n As Long
Const Decoupe As Long = 625
    Application.ScreenUpdating = False
    With Sheets("Feuil1")
        a = .Range("a1", Range("a" & Rows.Count).End(xlUp)).Value
        ReDim b(1 To UBound(a, 1) \ Decoupe + 1, 1 To Decoupe)
        For i = 1 To UBound(a, 1) Step Decoupe
            n = n + 1
            For j = 1 To Decoupe
                If i + j - 1 > UBound(a, 1) Then Exit For
                b(n, j) = a(i + j - 1, 1)
            Next
        Next
        For i = 1 To UBound(b, 1)
            .Cells(1, i + 2).Resize(UBound(b, 2)).Value = _
            Application.Transpose(Application.Index(b, i, 0))
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Pas sûr que le résultat escompté soit le bon, même si la disposition de tes colonnes sera respectée.

Mais bon, sans fichier exemple

klin89

Bonsoir Nicodan, bonsoir le forum,

Peut-être comme ça :

Sub Macro4()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Byte 'déclare la variable K (incrément)

Set O = Sheets("Feuil1") 'définit l'onglet O (à adapter)
TC = O.Range("A1").CurrentRegion 'définit le tableau de cellules TC
NL = UBound(TC, 1) 'définit le nombre de lignes NL du tableau de cellules TC
J = 1 'initialise la variable J
K = 1 'initialise la variable K
For I = 1 To NL 'boucle sur toutes les lignes I du tableau de cellules TC
    ReDim Preserve TL(1 To 625, 1 To K) 'redimensionne le tableau de lignes TL (625 lignes, K colonnes)
    TL(J, K) = TC(I, 1) 'récupère dans la ligne J colonne K de TL la valeur en ligne I colonne 1 de TC
    J = J + 1 'incrémente J
    If J = 626 Then 'condition : si J est égale à 626
        K = K + 1 'incrémente K (ajoute une colonne à TL)
        J = 1 'réinitialsie J
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
O.Range("C1").Resize(625, K - 1) = TL 'renvoie dans C1 (à adapter) le tabelau TL
End Sub

[Édition]

Bonsoir Klin on s'est croisé...

Merci à vous 2.

Désolé j'aurais du être plus précis dans ma demande. Voir plus bas un exemple du résultat final.

Dans le fond le plus important pour moi c'est d'avoir un macro qui transposera n'importe quelle liste de chiffres sur un nombre de colonne déterminés. Les chiffres 7500, 625 et 12 colonnes était seulement à titre d'exemple. Le macro que je recherche serait modifiable selon le nombre colonne souhaité ( peu être 14, 16 ou 18 etc...)

Merci encore de votre aide

DATA ORIGINAL

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

TRANSPOSITION SOUHAITÉ

1 2 3 4 5 6 7 8 9 10 11 12

13 14 15 16 17 18 19 20 21 22 23 24

Re Nicodan,

Si tu repasses :

Option Explicit

Sub Decoupage()
Dim tablo, t(), NbreBloc As Long, j As Long
Const bloc As Long = 12 '<- modifie le nbre de colonnes
    Application.ScreenUpdating = False
    With Sheets("Feuil1")
        tablo = .Range("a1", .Range("a" & Rows.Count).End(xlUp)).Value
        If UBound(tablo, 1) Mod bloc = 0 Then
            NbreBloc = UBound(tablo, 1) \ bloc
        Else
            NbreBloc = UBound(tablo, 1) \ bloc + 1
        End If
        ReDim t(1 To NbreBloc, 1 To bloc)
        For j = 1 To UBound(tablo, 1)
            t((j - 1) \ bloc + 1, (j - 1) Mod bloc + 1) = tablo(j, 1)
        Next
        'Restitution
        .Cells(1).Offset(, 2).Resize(NbreBloc, bloc) = t
    End With
    Application.ScreenUpdating = True
End Sub

klin89