Macro avec Range non défini
Bonjour
Dans ma macro , je fais faire des sous-totaux pour chaque vendeur. Je voudrais deux choses: en faisant les sous-totaux, Excel inscrit TOTAL (nom du vendeur), avec le total numérique. Les mots TOTAL et (nom du vendeur) sout en gras, alors que le total numérique ne l'est pas. Puisque le faire sortir à l'écran en gras pour le différencier plus facilement lorsque je cliquerai sur le petit carré avec le signe "+" pour ouvrir le détail de ce vendeur. Deuxièment, encore une fois pour différencier (plus facile à lire disons) puis-je ajouter une ligne vide entre chaque Total pour que , encore une fois, lorsque j'ouvrirai le détail ce sera plus facile pour la visualisation.
Voici mon code:
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
| Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1:E1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("F2").Select
Selection.Copy
Range("A1:E1").Select
ActiveSheet.Paste
Range("A1:E24").Select
Range("E24").Activate
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Application.CutCopyMode = False
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
'Range("A2:E50").Select
Range("A37").Activate
Selection.Font.Bold = False
Selection.Font.Bold = True
Selection.Insert Shift:=xlDown
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("A:A").ColumnWidth = 30.29
Columns("C:C").ColumnWidth = 7.86
Columns("D:D").ColumnWidth = 13.86
Columns("E:E").ColumnWidth = 8.43
Range("F51").Select
End Sub |
Merci de votre aide
