Transposer certaines lignes d'un fichier en colonne

Signaler
Messages postés
2
Date d'inscription
lundi 12 octobre 2020
Statut
Membre
Dernière intervention
15 octobre 2020
-
Messages postés
12654
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
17 octobre 2020
-
Bonjour,

J essaie en vain de coder 1 macro ! quelle galère...

Dans le fichier Excel reçu, les informations sont disposées en ligne, et ces informations sont attendues en colonne.
Et c'est un peu plus compliqué qu'un coller transposer.

voici les infos reçues :
Produit Caractéristique1 Caractéristique2 Couleur Nombre
référence 1 crayon feutre Rouge 3
référence 1 crayon feutre Vert 2
référence 2 crayon papier Jaune 2
référence 2 crayon papier Noir 3

et la disposition attendue :
Produit Caractéristique1 Caractéristique2 Rouge Vert Bleu Rose Jaune
référence 1 crayon feutre 3 2 1 4
référence 2 crayon papier 1 2

L'entête résultat est figée = le rouge est toujours assigné à la colonne D, le vert la E...
Et dans le fichier résultat la référence 1 ne doit figurer qu'une fois..

Le tableau résultat pourrait être créé idéalement sur une deuxième feuille.

Si vous pouviez m'aider avec la bonne macro, ce serait un aide énorme pour moi.

Merci!

3 réponses

Messages postés
12654
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
17 octobre 2020
702
bonjour,
ton exemple est-il correct?
Messages postés
12654
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
17 octobre 2020
702
connais-tu les tableaux croisés dynamiques?
Messages postés
2
Date d'inscription
lundi 12 octobre 2020
Statut
Membre
Dernière intervention
15 octobre 2020

Bonjour ! Je ne connais pas les tableaux croisés dynamiques. je m'en suis sortie en copiant le code de Raja (sur un autre site)
Merci pour vos commentaires !
(je ne sais pas comment cloturer cette demande)


Option Explicit
Sub toColumns()
Dim wsSource As Worksheet, wsDest As Worksheet
Dim derLig, i, k, lig, col As Long
Set wsSource = Sheets(1)
Set wsDest = Sheets(2)
On Error Resume Next
derLig = wsSource.Range("A" & Rows.Count).End(xlUp).Row
k = 2
For i = 2 To derLig
With wsSource
'données Crayon :
If WorksheetFunction.CountIf(wsDest.Columns(1), .Cells(i, "A")) = 0 Then
wsDest.Cells(k, "A") = .Cells(i, "A")
wsDest.Cells(k, "B") = .Cells(i, "B")
wsDest.Cells(k, "C") = .Cells(i, "C")
k = k + 1
End If
'valeurs selon entête Coloris :
lig = WorksheetFunction.Match(.Cells(i, "A"), wsDest.Columns(1), 0)
col = WorksheetFunction.Match(.Cells(i, "D"), wsDest.Rows(1), 0)
wsDest.Cells(lig, col) = .Cells(i, "E")
End With
Next i
Set wsSource = Nothing
Set wsDest = Nothing
End Sub
Messages postés
12654
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
17 octobre 2020
702
Merci, dans le futur, de nous informer immédiatement quand tu poses la même question sur un autre forum.
Messages postés
12654
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
17 octobre 2020
702
n'as-tu pas un bouton vert "marquer comme résolu"?