calyburo a écrit :
Je n'ai pas tout compris, mais si vous me dites que c'est galère, pas de souci.
Je n'ai fait qu'une modif de mise en forme mais je vous joins le fichier
Mille mercis encore
Bonsoir,
En pj le fichier.
Merci de me dire si cela vous convient.
Le fonctionnement est simple :
Placer le tableau "avec les titres" récupéré du fichier PT dans la feuille Inventaire.
PS: j'ai mis un exemple pour vous guider.
Aller sur la première fiche et cliquez sur le bouton et voila vous trouverez vos données condensées dans la feuille Résultat inventaire avec un joli tableau mis en forme.
Attention : avant de lancer,s'assurer que la feuille Résultat Inventaire est vidé !
Pour les puristes voici le code:
Sub doublon_inventaire()
'transpose colonne
Sheets("Resultat Inventaire").Range("A1") = "EAN"
Sheets("Resultat Inventaire").Range("B1") = "Quantité"
'definition derniere ligne on se base sur A car toujours saisie
dlgu = Sheets("Inventaire").Range("C" & Rows.Count).End(xlUp).Row
'creation code unicité dans inventaire
Sheets("Inventaire").Select
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Indice"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]="""",RC[2],RC[1])"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & dlgu)
Range("A2:A" & dlgu).Select
'definition derniere ligne on se base sur A car toujours saisie
dlgi = Sheets("Inventaire").Range("C" & Rows.Count).End(xlUp).Row
dlgr = Sheets("Resultat Inventaire").Range("A" & Rows.Count).End(xlUp).Row
'on recupere les lignes sans doublons
Sheets("Inventaire").Range("A2:A" & dlgi).Select
Selection.Copy
Sheets("Resultat Inventaire").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$" & dlgi).RemoveDuplicates Columns:=1, Header:=xlYes
'derniere ligne une fois cadencé
dlg_cad = Sheets("Resultat Inventaire").Range("A" & Rows.Count).End(xlUp).Row
'somme sur les elements regroupés
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=SUMIF(Inventaire!RC[-1]:R[" & dlgi & "]C[-1],'Resultat Inventaire'!RC[-1],Inventaire!RC[2]:R[" & dlgi & "]C[2])"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B" & dlg_cad)
'Finalisation ### Creation tableau / copier coller valeur plus de formule ###
Columns("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1:B" & dlg_cad).Select
Application.CutCopyMode = False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$B$" & dlg_cad), , xlYes).Name = _
"Tableau3"
Range("Tableau3[#All]").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.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
Sheets("Inventaire").Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Sheets("Feuil1").Select
terminer:
MsgBox " Traitement terminé" & Chr(10) & "Le resultat se trouve dans la feuille Résultat Inventaire"
End Sub