Bonjour @Pator,
Salut @DocteurExcel,
Une proposition différente par VBA, si ça répond à la demande.
Faire un appui sur le bouton « GO » placé sur la feuille « Fichier initial » à la hauteur de « E1 ».
Traitement de la colonne « C » sans doublons, puis répartition des lignes de la colonne « D » en colonnes dans la feuille « Résultat ».
Traitement « Ne pas renvoyer à la ligne automatiquement »
Mise en forme des largeurs colonnes et mise en forme « Style de tableau moyen 7 ».
Fait pour 10000 lignes, donc ajustable a partir de la macro.
La macro:
Sub GO()
Dim J As Long
Dim I As Integer
Dim K As Long
Dim Indice As Long
Dim Tablo
Dim Nb As Integer
Application.ScreenUpdating = False
ReDim Tablo(1 To Range("A" & Rows.Count).End(xlUp).Row - 2, 1 To 2)
Tablo(1, 1) = Range("C2")
Tablo(1, 2) = Range("D2")
Nb = 1
For J = 3 To Range("A" & Rows.Count).End(xlUp).Row
For K = 1 To UBound(Tablo)
If Range("C" & J) = Tablo(K, 1) Then
For I = 1 To UBound(Tablo, 2)
If Tablo(K, I) = "" Then
Tablo(K, I) = Range("D" & J)
Exit For
End If
Next I
If I > UBound(Tablo, 2) Then
ReDim Preserve Tablo(1 To UBound(Tablo), 1 To UBound(Tablo, 2) + 1)
Tablo(K, UBound(Tablo, 2)) = Range("D" & J)
End If
Exit For
ElseIf Tablo(K, 1) = "" Then
Nb = Nb + 1
Tablo(K, 1) = Range("C" & J)
Tablo(K, 2) = Range("D" & J)
Exit For
End If
Next K
Next J
With Sheets("Résultat")
.Cells.ClearContents
.Range("A2").Resize(Nb, UBound(Tablo, 2)) = Tablo
.Range("A1") = "Column3"
.Range("B1") = "Column4"
.Range("B1").AutoFill .Range("B1").Resize(, UBound(Tablo, 2) - 1), xlFillSeries
.Select
Rows(1).Font.Bold = True
End With
Application.DisplayAlerts = False
Rows("2:10000").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Range("A1:C32").Select
Selection.AutoFilter
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$C$10000"), , xlYes).Name = _
"Tableau9"
Range("Tableau9[#All]").Select
ActiveSheet.ListObjects("Tableau9").TableStyle = "TableStyleMedium7"
Range("Tableau9[[#Headers],[Column3]]").Select
Application.DisplayAlerts = False
Application.ScreenUpdating = True
End Sub
Ci-joint ton fichier ICI==> Pator V1.xlsm (209,5 Ko)
Cordialement.
PS: Sur ce forum tu peux joindre directement ton fichier, sans passer par « cjoint.com ».
Pour ce faire suivre cette procédure: