Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Excel - Transposition de lignes

Excel - Transposition de lignes

1 réponse
Avatar
scrmbl
Bonjour,

Voici le problème :

J'ai un tableau du type :

Fourn. - FD00 - FD01 - FD02 - FD03 - ... - FD30
40401.....15 ........16.........17........18..............12
40402.....13..........11........10........ 9.............. 24
40403....14..........19.........2.......... 7...............17
40404.....15.........11........16.........18...............12

...
41400

J'ai environ 1000 lignes et 30 colonnes. Ce tableau se situe dans une "Feuil1", et j'aimerais le transposer dans la "Feuil2" de la façon suivante :

Fourn. Rubrique Valeur

40401 FD00 15
40401 FD01 16
40401 FD02 17
40401 FD03 18
40402 FD00 13
...

J'ai pensé à coder une Macro en VBA, mais ne connaissant pas du tout ce langage, je suis relativement perdu.

Pour le moment, j'ai trouvé quelque chose de ce type :
'-----------------------------------------------------------'
Sub test()

Dim Rg As Range, R As Range
Dim Col As Integer, Ligne As Long

On Error Resume Next

With Feuil1
Set Rg = .Range("A2:A" & .Range("A6556").End(xlUp).Row)
End With

Ligne = 1
For Each R In Rg.Rows
Col = R.EntireRow.Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

With Feuil2
.Range("A" & Ligne).Resize(Col - 1) = _
R.Cells(1, 1).Value
.Range("C" & Ligne).Resize(Col - 1) = _
Application.Transpose(R.Offset(, 1). _
Resize(, Col - 1).Value)
Ligne = Ligne + Col - 1
End With


Next
End Sub

'-----------------------------------------------------------'

Mes lignes sont bien transposées, par contre je ne sais pas comment modifier la chose de façon à transposer également mes rubriques.

Merci d'avance pour votre aide.

Cdt.

N.
Signaler un problème avec ce contenu

1 réponse

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
StephD
Bonjour,

Avec un truc comme ceci

Option Explicit

Sub MaTranspo()

Dim DerLig#, DerCol#
Dim i#, j#, k#
Dim mesdonnees

Application.DisplayAlerts = False: Application.ScreenUpdating =
False

With ActiveSheet
DerLig = .[A65536].End(3).Row
DerCol = .[IV1].End(1).Column
ReDim mesdonnees(1 To (DerLig * DerCol), 1 To 3)
For i = 2 To DerLig
For j = 2 To DerCol
k = k + 1
mesdonnees(k, 1) = .Cells(i, 1)
mesdonnees(k, 2) = .Cells(1, j)
mesdonnees(k, 3) = .Cells(i, j)
Next j
Next i
End With
On Error Resume Next: Sheets("Résultat").Delete: On Error GoTo 0
Sheets.Add(after:¬tiveSheet).Name = "Résultat"

With Sheets("Résultat")
.[A1].Resize(UBound(mesdonnees, 1), UBound(mesdonnees, 2)) =
mesdonnees
.Rows("1:1").Insert
.[A1] = "Fourn.": .[B1] = "Rubrique": .[C1] = "Valeur"
End With

Application.DisplayAlerts = True: Application.ScreenUpdating =
True

End Sub