Transposer des données en ligne

[DFER]

Bonjour,

Je suis confronté à une difficulté pour laquelle je ne trouve pas de solution compte tenu de mon niveau d'Excel.
Je dispose d'un fichier Excel qui comporte en colonne A un identifiant.
Cet identifiant peut dans certain cas se répéter sur plusieurs lignes mais avec des données qui seront différentes à partir de la colonne B jusqu'à la colonne Y.
Je voudrai exploiter ces données différemment pour n'avoir plus qu'une seul ligne. Dis autrement cela revient presque à mettre les données de la 2nd ligne à la suite de la 1ère.
L'exemple joint avec un fichier de départ et le fichier souhaité sera peut être plus clair que de longues explications.
J'ai trouvé, il y a longtemps, une macro qui permettait de faire ce traitement mais impossible de remettre la main dessus.
Merci d'avance pour vos contributions respectives.
Cordialement

Dominique

 

[DFER]

Bonsoir,
Je viens de trouver la solution en fouillant sur internet.
La solution est donnée sur ce lien :
https://www.extendoffice.com/fr/documents/excel/2538-excel-transpose-duplicate-row-to-columns.html

La macro utilisée est universelle car elle s'adapte au champ de données que vous voulez transposer.
Il n'y a donc aucune limitation.
Je ne sais pas si l'on peut donner le lien...je laisse le soin aux modérateurs d'apprécier.
Bonne soirée à tous.

Dominique

 

[job75]

Bonsoir DFER,

Ce problème a sûrement dû être traité sur XLD, sinon maintenant il le sera :

Private Sub Worksheet_Activate()
Dim P As Range, t, ncol%, d As Object, i&, resu(), lig&, s, j%
Set P = Feuil1.[A1].CurrentRegion 'CodeName de la feuille source
t = P 'matrice, plus rapide
If Not IsArray(t) Then GoTo 1
ncol = UBound(t, 2) - 1 'colonne identifiant non comptée
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 2 To UBound(t)
    d(t(i, 1)) = d(t(i, 1)) + 1 'comptage des doublons
Next i
If d.Count = 0 Then GoTo 1
ReDim resu(1 To d.Count, 1 To 1 + ncol * Application.Max(d.items))
d.RemoveAll
For i = 2 To UBound(t)
    If Not d.exists(t(i, 1)) Then
        lig = lig + 1
        d(t(i, 1)) = lig & " -1" 'repérage de la ligne
        resu(lig, 1) = t(i, 1)
    End If
    s = Split(d(t(i, 1))): s(1) = s(1) + 1
    d(t(i, 1)) = s(0) & " " & s(1)
    For j = 2 To ncol + 1
        resu(s(0), j + ncol * s(1)) = t(i, j)
Next j, i
'---restitution---
1 Application.ScreenUpdating = False
If AutoFilterMode Then ShowAllData 'si la feuille est filtrée
Cells.Delete 'RAZ
If lig = 0 Then Exit Sub
P(1).Resize(2).Copy [A1]
If ncol Then
    Set P = P.Rows(1).Resize(, ncol).Offset(, 1)
    For i = 1 To (UBound(resu, 2) - 1) / ncol
        P.Resize(2).Copy Cells(1, 2 + ncol * (i - 1)) '2 lignes copiées
        If i Mod 2 = 0 Then Cells(1, 2 + ncol * (i - 1)).Resize(, ncol).Interior.Color = vbGreen 'couleur alternée
    Next
End If
[A2].Resize(lig, UBound(resu, 2)) = resu 'restitution du tableau
If lig > 1 Then Rows(2).AutoFill Rows(2).Resize(lig), xlFillFormats 'copie les formats
Columns.AutoFit 'ajustement largeur
With UsedRange: End With 'actualise les barres de défilement
End Sub

C'est aussi une macro "universelle", la seule contrainte : l'identifiant doit être en 1ère colonne.

Fichier joint.

A+