VBA - Transposition de colonne

Bonjour à tous,

Par avance, merci pour votre habituelle aide !

Je dispose d'un tableau tel que celui ci-dessous.

image

En VBA, je souhaite réaliser une transposition pour arriver à ce résultat :

image

Je dispose donc d'un code VBA me permettant de réaliser ceci, hors je cherche à ajuster le code VBA pour que les dates qui suivent, notamment 02/10/2020 puissent s'ajouter après la dernière ligne, et ainsi de suite.

Option Explicit

Sub UnPivot()

    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion
    Dim rCount As Long: rCount = srg.Rows.Count
    If rCount < 2 Then Exit Sub

    Dim Data As Variant: Data = srg.Value

    Dim r As Long
    Dim c As Long
    For r = 2 To rCount
        For c = 4 To 2 Step -1
            Data(r, c) = Data(r, c - 1)
        Next c
        Data(r, 1) = Data(1, 3)
    Next r

    Data(1, 1) = "DATE"
    Data(1, 2) = "TITLE"
    Data(1, 3) = "KPI"
    Data(1, 4) = "VALUE"

    Dim drg As Range: Set drg = srg.Offset(, srg.Columns.Count + 1)
    drg.Value = Data

End Sub

J'ai tenté d'ajuster les variables depuis For r jusqu'à Next r mais cela sans succès.

Pouvez-vous m'aider ?

Grand merci !

Bonjour,

Pourrait-on disposer d'un classeur exemple?

sans macro, on va s'en débrouiller...

Bonjour à tous,

Voici un essai avec un code nécessitant que le tableau de départ soit un tableau structuré, nommé "tableau" dans le code :

sub test()
with range("tableau")
    redim t(1 to .rows.count * (.columns.count - 2), 1 to 4)
    for k = 3 to .columns.count
        for i = 1 to .rows.count
            n = n + 1
            t(n, 1) = IIf(IsDate(.Cells(0, k)), CDate(.Cells(0, k)), .Cells(0, k))
            t(n, 2) = .cells(i, 1)
            t(n, 3) = .cells(i, 2)
            t(n, 4) = .cells(i, k)
        next i
    next k
end with
with sheets.add(after:=sheets(sheets.count))
    .range("A1:D1").value = array("DATE", "TITLE", "KPI", "VALUE")
    with .listobjects.add(source:=.usedrange, xllistobjecthasheaders:=xlyes)
        .name = "NOM"
        .range(2, 1).resize(ubound(t), ubound(t, 2)) = t
    end with
end with
end sub

Le resultat est affiché dans une nouvelle feuille.

Cdlt,

Fantastique !!! Merci beaucoup

Rechercher des sujets similaires à "vba transposition colonne"