Transposer colonnes d'un tableau en lignes avec VBA

Bonjour,

J'ai un tableau composé d'une trentaine de colonnes reprenant des informations sur des produits.

12 de ces colonnes correspondent au chiffre d'affaire mensuel de ce produit. J'ai besoin que ces mois correspondant à des en-tête de colonnes soit convertis en ligne.

Il faudrait par ailleurs que l'année indiquée dans la colonne A soit reprise dans la nouvelle colonne correspondant aux mois.

Vous trouverez en Pièce-jointe un exemple plus visuel du fichier source et du rendu attendu.

Tout le Chiffre d'affaire doit être détaillé sur la colonne R avec la reprise des informations correspondantes au mois en question.

J’espère avoir été assez clair et merci d'avance pour votre précieuse aide !

Bien cordialement,

Benjamin

Bonjour,

Une proposition :

Sub TranspoCA()
    Dim aa, a%, nln%, lni%, m%, caC As Range, mois$
    Application.ScreenUpdating = False
    With ActiveSheet
        .Columns("Q:R").Insert
        .Range("Q1") = "Mois": .Range("R1") = "CA"
        With .Range("Q1:R1")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Interior.Color = RGB(255, 230, 153)
        End With
        nln = .Range("A1").CurrentRegion.Rows.Count - 1
        a = .Range("A2")
        aa = .Range("A2:P" & nln + 1).Value
        Set caC = .Range("R2").Resize(nln)
        For m = 1 To 12
            mois = MonthName(m, True) & "-" & a
            caC.Offset((m - 1) * nln).Value = caC.Offset(, m).Value
            caC.Offset((m - 1) * nln, -1).Value = "'" & mois
            If m > 1 Then
                lni = 2 + (m - 1) * nln
                .Range("A" & lni).Resize(nln, 16).Value = aa
            End If
        Next m
        With .Range("A1").CurrentRegion
            For a = 1 To 16
                .Columns(a).Font.Size = .Cells(2, a).Font.Size
                .Columns(a).Font.Bold = .Cells(2, a).Font.Bold
                .Columns(a).HorizontalAlignment = .Cells(2, a).HorizontalAlignment
            Next a
            .Columns(18).NumberFormat = .Cells(2, 19).NumberFormat
        End With
    End With
End Sub

Bouton sur le tableau source. La transposition se fait sur ce tableau...

Cordialement.

Bonjour MFerrand,

Merci beaucoup ton retour !

C'est "presque" exactement ce qu'il me fallait.

Un seul point au niveau des dates retournées dans la colonne R:

• Il faudrait dans l'idéal qu'elle soient au format JJ/MM/AAAA (01/01/2015) pour Janvier => jan-15 qui apparaît dans la cellule
• Lorsque je change dans la colonne A 2015 en 2016, cela me retourne quand même 2015 au lieu de 2016 dans la colonne R.

Si tu as une solution pour ce dernier "petit" problème , je suis preneur !

Encore merci pour ton aide .

Bien cordialement,

Benjamin

(J'ai updaté le fichier excel avec d'autres années dans la colonne A et dans le rendu espéré)

Il me semblait que le mélange d'années n'était pas de mise, et donc je ne la prends qu'une fois en A2, il est donc normal que tes modifications soient ignorées.

Dans la colonne Q, le mois est forcé en valeur texte, tu n'as donc pas une date.

Tu veux donc des dates en Q, avec année variable ligne par ligne ! Je regarde ça après manger...

Il faut que j'arrive à combiner ça avec le traitement de masse par plages entières !

Je vais peut-être créer une plage temporaire à 12 colonnes pour prédéfinir les dates, ce qui laisserait la structure de la proc. actuelle inchangée...

J'espère que dans les colonnes initiales Q:AB c'est bien les mois de janvier à décembre dans l'ordre, sans dérogation.

@+

MFerrand,

Une personne à trouvé la solution pour les dates.

Je te laisse le code ici si tu veux y jeter un œil.

Sub convertir()

Dim tabInit() As Variant

Dim tabFinal() As Variant

derlin = Range("A" & Rows.Count).End(xlUp).Row

With Sheets("Fichier source")

tabInit = .UsedRange.Value

nblignes = UBound(tabInit, 1) - 1

NbColonnes = UBound(tabInit, 2) - 10

End With

ReDim tabFinal(1 To (nblignes * 12) + 1, 1 To NbColonnes)

For j = LBound(tabInit, 2) To NbColonnes - 2

tabFinal(1, j) = tabInit(1, j)

Next j

For i = LBound(tabInit, 1) + 1 To UBound(tabInit, 1)

For j = LBound(tabInit, 2) To NbColonnes - 2

For k = 1 To 12

tabFinal(i + (k - 1) * nblignes, j) = tabInit(i, j)

Next k

Next j

For k = 1 To 12

tabFinal(i + (k - 1) * nblignes, NbColonnes - 1) = DateSerial(tabInit(i, 1), k, 1)

tabFinal(i + (k - 1) * nblignes, NbColonnes) = tabInit(i, NbColonnes - 2 + k)

Next k

Next i

With Sheets("Rendu")

.Range("A1").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal

.Range("Q1") = "Mois"

.Range("Q:Q").NumberFormat = "mmm-yyyy"

.Range("R1") = "CA"

End With

Worksheets("Rendu").Activate

Worksheets("Rendu").Range("S:AD").Select

Worksheets("Rendu").Range("S:AD").Clear

En tout cas merci pour ton aide et le temps que tu as passé dessus !

Bien cordialement,

Benjamin