Intervertir des colonnes en lignes dans un tableau

Bonjour à tous et à toutes,

J'espère que vous allez bien,

Dans l'exemple qui suit j'aimerai, grâce à une macro ou autre, obtenir le deuxième tableau à partir du premier.

Par avance merci infiniment pour votre aide,

Cordialement,

Roijio

Bonjour,

a priori :

Sub Special_Transpose()
Dim T1, TF(), i As Long, x As Long, DL As Long

DL = Range("M" & Rows.Count).End(xlUp).Row

T1 = Range("B3:M" & DL)
ReDim TF(1 To (UBound(T1, 1) - 1) * 3 + 1, 1 To 7)

'Ligne de titre
TF(1, 1) = T1(1, 1)
TF(1, 2) = T1(1, 2)
TF(1, 3) = T1(1, 3)
TF(1, 4) = "année"
TF(1, 5) = "Quantité"
TF(1, 6) = "Masse/quantité"
TF(1, 7) = "émissions"

'constitution nouveau tableau
For i = LBound(T1, 1) + 1 To UBound(T1, 1)
    x = 0
    For j = i * 3 - 4 To i * 3 - 2
        x = x + 1
        TF(j, 1) = T1(i, 1)
        TF(j, 2) = T1(i, 2)
        TF(j, 3) = T1(i, 3)
        TF(j, 4) = T1(1, 3 + x)
        TF(j, 5) = T1(i, 3 + x)
        TF(j, 6) = T1(i, 6 + x)
        TF(j, 7) = T1(i, 9 + x)
     Next
Next

'copie du nouveau tableau
Range("B17").Resize(UBound(TF, 1), UBound(TF, 2)) = TF
End Sub

A+

Bonjour

Bonjour à tous

Une variante à tester.

Option Explicit

Dim tablo, tabloR()
Dim i&, iR&, j&, col&

Sub NouveauTableau()

    tablo = Range("B3").CurrentRegion
    ReDim tabloR(1 To (UBound(tablo, 1) - 2) * 3 + 1, 1 To 7)
    tabloR(1, 1) = tablo(2, 1)
    tabloR(1, 2) = tablo(2, 2)
    tabloR(1, 3) = tablo(2, 3)
    tabloR(1, 4) = "année"
    tabloR(1, 5) = tablo(1, 4)
    tabloR(1, 6) = tablo(1, 7)
    tabloR(1, 7) = tablo(1, 10)

    iR = 1
    For i = 3 To UBound(tablo, 1)
        For col = 4 To 6
            tabloR(iR + 1, 1) = tablo(i, 1)
            tabloR(iR + 1, 2) = tablo(i, 2)
            tabloR(iR + 1, 3) = tablo(i, 3)
            tabloR(iR + 1, 4) = tablo(2, col)
            tabloR(iR + 1, 5) = tablo(i, col)
            tabloR(iR + 1, 6) = tablo(i, col + 3)
            tabloR(iR + 1, 7) = tablo(i, col + 6)
            iR = iR + 1
        Next col
    Next i

    Rows(UBound(tablo, 1) + 2 & ":" & Rows.Count).Clear
    Range("B" & UBound(tablo, 1) + 5).Resize(UBound(tabloR, 1), 7) = tabloR
    With Range("B" & UBound(tablo, 1) + 5).Resize(UBound(tabloR, 1), 7)
        .Borders.LineStyle = xlContinuous
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
    End With
End Sub

Bye !

Bonjour,

Une autre proposition réalisée avec Power Query, sans VBA.

Cdlt.

Bonjour à tous

Arf trop tard, Jean-Eric m'a devancé

Seule différence j'ai créé et utilisé une plage nommée pour la source...

Bonjour à tous,

Merci beaucoup pour votre aide ça marche parfaitement,

En vous souhaitant une bonne journée,

cordialement,

Roijio 😁