Bonjour,
Le forum m'ayant déjà bien aider, je reviens vers vous pour essayer de trouver la bonne macro pour trier des références , sortir les sous totaux et ne garder qu'eux.
J'ai enregistré la macro suivante avec l'enregistreur d'excel, mais c'est long.
Sub Trie_Référence()
ActiveWorkbook.Worksheets("Références").AutoFilter .Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Références").AutoFilter .Sort.SortFields.Add Key:= _
Range("H1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Références").AutoFilter .Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:M1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Subtotal GroupBy:=8, Function:=xlSum, TotalList:=Array(10, 11, 12 _
), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Cells.Select
Range("A157").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollRow = 160
ActiveWindow.ScrollRow = 125
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 1
ActiveSheet.Range("$A$1:$M$217").AutoFilter Field:=8, Criteria1:= _
"<>*total*", Operator:=xlAnd
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
ActiveSheet.Range("$A$1:$M$31").AutoFilter Field:=8
End Sub
Merci d'avance.
Broch002
Le forum m'ayant déjà bien aider, je reviens vers vous pour essayer de trouver la bonne macro pour trier des références , sortir les sous totaux et ne garder qu'eux.
J'ai enregistré la macro suivante avec l'enregistreur d'excel, mais c'est long.
Sub Trie_Référence()
ActiveWorkbook.Worksheets("Références").AutoFilter .Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Références").AutoFilter .Sort.SortFields.Add Key:= _
Range("H1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Références").AutoFilter .Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:M1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Subtotal GroupBy:=8, Function:=xlSum, TotalList:=Array(10, 11, 12 _
), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Cells.Select
Range("A157").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollRow = 160
ActiveWindow.ScrollRow = 125
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 1
ActiveSheet.Range("$A$1:$M$217").AutoFilter Field:=8, Criteria1:= _
"<>*total*", Operator:=xlAnd
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
ActiveSheet.Range("$A$1:$M$31").AutoFilter Field:=8
End Sub
Merci d'avance.
Broch002
Dernière édition: