Récuperer des données en ligne et les ordonner en colonne

Bonjour à tous,

Je suis nouveau sur le forum, et je cherche une macro xls pour transformer dans autre onglet 1 (cas1) en résultat (onglet 2) de l'exemple ci dessous.

Merci !

cas 1

CODE HC01 HS01 HS02 HS03 HS04

255 255 255 255 255

1008 3 0 0 0 100

1210 20 10 0 0 0

Resultat

CODE

1008 255 HC01 3

1008 255 HS01 0

1008 255 HS02 0

1008 255 HS03 0

1008 255 HS04 100

1210 255 HC01 20

1210 255 HS01 10

Salut et bienvenue sur le Forum,

Si je t’ai bien compris, la macro jointe à mon fichier – lancée depuis le bouton en place sur la Feuil1 – devrait effectuer ce que tu désires.

Option Explicit

Sub aa()
Dim i As Integer, j As Integer, Compteur As Integer

Application.ScreenUpdating = False
Compteur = 1

With Sheets("Feuil2")
    .Rows("2:" & Rows.Count).Delete

    For i = 3 To Range("A" & Rows.Count).End(xlUp).Row
        For j = 2 To Cells(2, Columns.Count).End(xlToLeft).Column
            Compteur = Compteur + 1
            .Range("A" & Compteur) = Cells(i, 1)
            .Range("B" & Compteur) = Cells(2, j)
            .Range("C" & Compteur) = Cells(1, j)
            .Range("D" & Compteur) = Cells(i, j)
        Next j
    Next i

.Range("A2:D" & Compteur).Borders.Weight = xlThin
.Activate

End With

End Sub

Cordialement.

Bonjour,

Bonjour Yvouille,

Une adaptation avec la création d'un tableau (Excel 2007+) et le nommage des champs de colonnes.

A adapter dans ton environnement.

Cdlt.

Option Explicit
Option Private Module
Public Sub TransposerTableau()
' declaration des variables
Dim wsS As Worksheet, wsD As Worksheet
Dim lastRow As Long, lRow As Long, rw As Long
Dim lastCol As Integer, iCol As Integer, i As Integer
Dim Cell As Range
Dim lo As ListObject

    Application.ScreenUpdating = False
    ' initialisation des objets
    Set wsS = Worksheets("Feuil1")
    Set wsD = Worksheets("Feuil2")
    ' dernieres lignes et colonnes tabeau initial
    With wsS
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    End With
    ' normalisation du tableau
    With wsD
        .Cells.Clear
        .[A1:D1] = Array("Code", "Code_import", "xxx", "Valeur")
        rw = 2
        For lRow = 3 To lastRow
            For iCol = 2 To lastCol
                .Cells(rw, 1) = wsS.Cells(lRow, 1)
                .Cells(rw, 2) = wsS.Cells(2, iCol)
                .Cells(rw, 3) = wsS.Cells(1, iCol)
                .Cells(rw, 4) = wsS.Cells(lRow, iCol)
                rw = rw + 1
            Next iCol
        Next lRow

        Set Cell = .[A1]
        ' initialisation du tableau cree
        Set lo = .ListObjects.Add(xlSrcRange, Cell.CurrentRegion, , xlYes)
        ' mise en forme du tableau
        With lo
            .Name = "Tableau1"
            .TableStyle = "TableStyleLight1"
            iCol = .ListColumns.Count
        End With
        ' gestionnaire de noms
        For i = 1 To iCol
            ActiveWorkbook.Names.Add Name:="d." & .Cells(1, i), _
                RefersToR1C1:="=" & lo.Name & "[" & .Cells(1, i) & "]"
        Next

    End With

    wsD.Activate
    [A1].Select

    Set wsS = Nothing: Set wsD = Nothing: Set lo = Nothing: set Cell = Nothing

End Sub

Merci à vous !