Excel dédoubler en renseignent colonnes

Bonsoir,
Malheureusement ce n'est pas si simple. Mon fichier comprend 21150 lignes et environ 2640 doublons ou triplons... Alors il me faudrait 1 macro... et je maitrise pas suffisement VBA...

Ah ui d'accord je me doutais bien evidemment que c'était plus compliqué mais j'avai pas compris ça du tout... euh la honnetement je te conseille de voir avec raymond PENTIER ci dessous :)
Bon Courage :)

Bonsoir les Antilles en Auvergne à Volvic il fait 3°.
Je ne maitise pas VBA, je "bricole" .
Mon fichier comprend 21150 lignes et environ 2640 doublons ou triplons... Alors il me faudrait 1 macro...

En faite je pense qu'avec une macro qui s'arrêterait sur la 2éme ligne de valeurs identiques, puis copirait les 2 cellules fabricant et réf. en se décalant de 2 colonnes sur la droite et remonterait d'1 ligne, puis effacerait cette ligne testée et reviendrait sur la 1 er cellule de la ligne complémenté, pour continer le test de doublon.
Merci de votre aide..

Bonjour,
Merci de votre aide.
J'ai fais des petites macros avec excel 4. Maintenant c'est autres choses....
Il me faut plus que la suppression des lignes de doublons, car ce qui fait la mutiplication des lignes des ITEM est en colonnes X, Y, et je veux inserer des colonnes pour concerver ces données en Z, AA, AB, AC, voir l'exemple.
Cordialement

Re,
Je me fais mal comprendre, dans l'onglet Brut, le code article 0111857 est dupliqué 3 fois, car en colonne X ce code article a 4 fabricants differents. Dans l'onglet Resultat j'ai inseré 3 colonnes FABRICANT et REF FABRICANT, Z, AA, AB, AC, AD, AE, pour copier ces info.

Cordialement
Louchadiere

Bonjour,
Tous mes voeux pour cette nouvelle année et etc...
Je me sers de cette macro chaque début de mois.
J'ai rajouté le classement en grandissant des catalogues et des fournisseurs.
Juste un problème que je n'arrive pas à résoudre la 3iéme phase se passe bien (classement en ligne des doublons au dela du 4iéme), mais la 4iéme phase l'injection des fabricants et Réf. au dela du 4iéme ne marche pas.
En attendant votre aide je fais manuellement.
Aussi ne serait il pas possible de déterminer le N° de la derniere ligne des tableaux pour paramétrer la macro.
Merci de partager votre savoir
Louchadiere

Bonjour,
L'inscertion des 2 lignes d'instruction permet d'inscerer toutes les colonnes suivant Nb max Dbl, mais ne copie par les entête de colonne et les données correspondant.
Pourriez vous documenter chaques instruction, aici je pourrais peut être être autonome...
Merci

Sub SupDoublonsColB()
' 1 Copie liste sans doublon dans résultat
Application.ScreenUpdating = False
Range("nbmaxdbl") = 0
Sheets("Resultat").Range("A1").CurrentRegion.Clear
Set sh = Sheets("Articles_PDR_Requête")
a = sh.Range("A1").CurrentRegion.Value
Set cbd = sh.Range("B1:B" & sh.Cells(Rows.Count, 1).End(xlUp).Row)
Dim c()
ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
ligne = 1
Set mondico = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(a)
If Not mondico.exists(a(i, 2)) Then
mondico.Add a(i, 2), 1
For k = 1 To UBound(a, 2): c(ligne, k) = a(i, k): Next k

nbd = WorksheetFunction.CountIf(cbd, a(i, 2))
If nbd > Range("nbmaxdbl") Then Range("nbmaxdbl") = nbd
ligne = ligne + 1
End If
Next
Sheets("Resultat").[A1].Resize(mondico.Count, UBound(c, 2)) = c
Set sh = Nothing
Set cbd = Nothing
Set mondico = Nothing
Application.ScreenUpdating = True
' MsgBox "Voir feuille [Resultat]"
End Sub

Sub Doublons()
'2 Extraire les doublons, liste [ITEM_ID / FABRICANT / REF FABRICANT] dans TemDbl
Dim dl As Integer
With Sheets("TempDbl")
.Range("G2:P" & .Cells(Rows.Count, 4).End(xlUp).Row + 1).Clear
Sheets("Articles_PDR_Requête").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.[A1:A2], CopyToRange:=.[D1:F1], Unique:=True

dl = .Cells(Rows.Count, 4).End(xlUp).Row
' format nombre pour colonne [ITEM_ID]
.Range("A3") = 1
.Range("A3").Copy
.Range("D2:D" & dl).PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
.Range("A3").Clear
.Columns("D:F").Sort Key1:=.Columns("D"), Order1:=xlAscending, Header:=xlGuess
End With

'Classer ITEM_ID & FABBRICANT
Range("d1").Select
Selection.End(xlDown).Select
Cells(ActiveCell.Row, "F").Select
ActiveWorkbook.Names.Add Name:="fin_colon_F", RefersToR1C1:=Selection
Range("D1:fin_colon_F").Select
Columns("D:F").Select
ActiveWorkbook.Worksheets("TempDbl").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("TempDbl").Sort.SortFields.Add Key:=Columns("D") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("TempDbl").Sort.SortFields.Add Key:=Columns("E") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("TempDbl").Sort
.SetRange Range("D1:fin_colon_F")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("D:F").EntireColumn.AutoFit

End Sub

Sub recupfabrefsupdoub()
'3 Range fabricant et réf par articles dans TempDbl
With Sheets("TempDbl")
nbd = Range("nbmaxdbl")
For c = .Cells(Rows.Count, 4).End(xlUp).Row To 2 Step -1
If .Cells(c, "D") = .Cells(c, "D").Offset(-1, 0) Then
' MsgBox "doublons : " & Cells(c, "D")
.Range(.Cells(c, 5), .Cells(c, 5 + (nbd * 2) - 1)).Copy Destination:=.Cells(c, "g").Offset(-1, 0)
.Rows(c).Delete
End If
Next c
End With
Columns("D:AK").EntireColumn.AutoFit
End Sub

Sub insertfabr()
'4 Injecte les divers fabricants et réf dans Resultat
Set sh = Sheets("TempDbl")
nbd = Range("nbmaxdbl")

With Sheets("Resultat")
'.Columns("Z").Resize(, 2 * (6).Insert
.Columns("Z").Resize(, 2 * (nbd - 1)).Insert

sh.Range(sh.Cells(1, 7), sh.Cells(1, 12)).Copy Destination:=.Cells(1, "Z")
For c = 2 To sh.Cells(Rows.Count, 5).End(xlUp).Row
nuli = WorksheetFunction.Match(sh.Cells(c, 4), .Range("B:B"), False)
sh.Range(sh.Cells(c, 5), sh.Cells(c, 12)).Copy Destination:=.Cells(nuli, "X")
Next c
End With
Columns("x:AF").EntireColumn.AutoFit
Range("A1").Select
ActiveWindow.SplitRow = 0.705882352941177
Selection.AutoFilter
End Sub