Transformer une très longue colonne en tableau

Bonjour à toutes et à tous,

Je bloque sur un petit problème Excel depuis ce matin et après avoir écumé les recherches Google FR & EN je me résous à solliciter votre aide, mes excuses si ma requête vous paraît évidente !

J'ai une très longue colonne dans laquelle se trouvent des infos clients.

1 client = 7 lignes

Je cherche tout simplement à "diviser" la colonne pour obtenir un tableau.

Mais je sèche complètement

D'avance merci pour votre aide

Bonnjour,

est ce que ça répond à ta demande ?

Bonjour Narr0,

Avec un fichier se serait plus facile de travailler, mais voici un code a essayer :

Sub test()
Dim derlgn&, Nb_Client, i&, j&
Dim ws As Worksheet
Dim Tab_Result, Tab_BDD

    Set ws = ActiveSheet
    derlgn = ws.Range("A" & Rows.Count).End(xlUp).Row
    Tab_BDD = ws.Range("A1:A" & derlgn)

    Nb_Client = derlgn / 7
    ReDim Tab_Result(Nb_Client - 1, 7 - 1)

    With ws

        For j = 0 To Nb_Client - 1
            For i = 0 To UBound(Tab_Result, 1) - 1
                Tab_Result(j * 7, i) = ws.Cells((j + 1) + i, 1)
            Next i
        Next j

        .Range("B1").Resize(UBound(Tab_Result, 1), UBound(Tab_Result, 2)) = Tab_Result

    End With

    Set ws = Nothing

End Sub

Florian 53, super maintenant je me sens idiot avec mon code fait à moitié avec l'enregistreur de macro

Bonjour,

Une variante qui te fera ça très bien... Si le tableau commence en A1 !

Sub Galopin()
Dim rng As Range, Tablo, i%, ii%
Set rng = [A1].CurrentRegion
With rng
    Set rng = .Resize(.Rows.Count, 8)
End With
Tablo = rng.Value
For i = 0 To UBound(Tablo) - 1
ii = Int(i / 7) + 1
Tablo(ii, i Mod 7 + 2) = Tablo(i + 1, 1)
Next
rng = Tablo
Columns(1).Delete
End Sub

A+

C'est super, ça fonctionne, merci beaucoup à vous 3 !

Bonjour,

Avec un peu de retard !...

Cdlt.

Public Sub Transpose_Data()
Dim ws As Worksheet, ws2 As Worksheet
Dim rng As Range
Dim lastRow As Long, lRow As Long, rw As Long
Const X As Long = 7

    Set ws = Worksheets("Input")
    Set ws2 = Worksheets("Output")

    ws2.Cells.Clear

    With ws
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For lRow = 1 To lastRow Step X
            rw = rw + 1
            Set rng = .Cells(lRow, 1).Resize(X)
            ws2.Cells(rw, 1).Resize(, X).Value = Application.Transpose(rng)
        Next lRow
    End With

    ws2.Activate

End Sub