Transformer ligne en colonne tout en gardant les info utiles

Bonjour à tous,

J'ai besoin d'aide sur un fichier Excel

Mon problème est le suivant :

Sur la première ligne j'ai toute les dates de l'année et pour chaque référence les quantités correspondantes.

Ce que je souhaiterai c'est avoir une colonne date et une colonne quantité qui reprend pour chaque référence la quantité produite à cette date.

Afin que vous puissiez mieux comprendre j'ai essayé de représenter un exemple de ma feuille Excel ci-dessous :

Nom Type 01/01/2018 02/01/2018 03/01/2018 04/01/2018 05/01/2018

Réf 1 Type A 100 600 200 0 500

Réf 2 Type B 300 400 700 0 800

Réf 3 Type C 0 600 900 1300 1700

Afin de pouvoir créer mon indicateur j'aurai besoin de la transformer comme ci-dessous :

Nom Type Date Qté

Réf 1 Type A 01/01/2018 100

Réf 1 Type A 03/01/2018 200

Réf 1 Type A 05/01/2018 500

Réf 2 Type B 01/01/2018 300

Réf 2 Type B 02/01/2018 400

Réf 2 Type B 03/01/2018 700

Réf 2 Type B 05/01/2018 800

Réf 3 Type C 02/01/2018 600

Réf 3 Type C 03/01/2018 900

Réf 3 Type C 04/01/2018 1300

Réf 3 Type C 05/01/2018 1700

Je ne suis pas du tout expert sur VBA mais je pense que ça doit être faisable et ça me simplifierait bcp les choses.

Merci d'avance pour votre aide sur le sujet.

Cdt,

Anthony

bonjour

joins un fichier

à mon avis, Menu Données, Obtenir

puis clic droit dans la colonne A

et "supprimer TCD des autres colonnes"

à te relire

amitiés

Merci beaucoup pour ton retour rapide.

Ci-joint un fichier avec sur l'onglet 1 ce que j'ai et sur l'onglet 2 ce que je souhaiterai.

Merci d'avance pour ton aide.

Cdt,

Anthony

Slt Anthony,

à tester

Sub transformerT()
Dim x As Worksheet, y As Worksheet
Dim i As Integer, j As Integer, lastrow_x As Integer, lastrow_y As Integer, lastcol_x As Integer
Dim z As Range
Dim FillRange As Variant

Set x = ThisWorkbook.Sheets(1)
Set y = ThisWorkbook.Sheets(2)
Set z = x.UsedRange

lastrow_x = z.Rows.Count
lastcol_x = z.Columns.Count

FillRange = VBA.Array("Nom", "Type", "Date", "Qté")
y.Range("A1:D1").Value = FillRange

lastrow_y = y.Range("A1").Rows.Count + 1

    For i = 2 To lastrow_x
        For j = 3 To lastcol_x
            If x.Cells(i, j).Value <> 0 Then
                y.Cells(lastrow_y, 1).Value = x.Cells(i, 1).Value
                y.Cells(lastrow_y, 2).Value = x.Cells(i, 2).Value
                y.Cells(lastrow_y, 3).Value = x.Cells(1, j).Value
                y.Cells(lastrow_y, 4).Value = x.Cells(i, j).Value
                lastrow_y = lastrow_y + 1
            End If
        Next j
    Next i
y.UsedRange.Replace What:="Référence", Replacement:="Réf", MatchCase:=True
End Sub

C'est exactement ce que je voulais.

Merci bcp pour ton aide !!

Anthony