Discussion :

[MarcTer]

Bonjour à tous,
j'ai fait ce code avec l'enregistreur de macro. Je l'ai un peu allégé mais il m'a l'air encore bien lourd au regard de son action ...
comment puis-je le simplifier
merci d'avance
cordialement
Marc

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Sub alerte2()
'
' alerte2 Macro
'
 
'
    Application.ScreenUpdating = False
    Sheets("util").Select
    Range("F30:I446").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("bd").Select
    ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=13, Criteria1:= _
        "Présent"
    ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=10, Criteria1:= _
        RGB(255, 0, 0), Operator:=xlFilterCellColor
    Range("Tableau1").Select
    ActiveWorkbook.Worksheets("bd").ListObjects("Tableau1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("bd").ListObjects("Tableau1").Sort.SortFields.Add( _
        Range("Tableau1[fin CDAPH]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
        SortOnValue.Color = RGB(255, 0, 0)
    ActiveWorkbook.Worksheets("bd").ListObjects("Tableau1").Sort.SortFields.Add _
        Key:=Range("Tableau1[Accompagnateurs]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("bd").ListObjects("Tableau1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("Tableau1[[#Headers],[fin CDAPH]]").Select
    Selection.Copy
    Sheets("util").Select
    Range("F30").Select
    ActiveSheet.Paste
    Sheets("bd").Select
    Range("Tableau1[fin CDAPH]").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("util").Select
    Range("F30").Select
    ActiveSheet.Paste
    Sheets("bd").Select
    Range("Tableau1[Nom]").Select
    Application.CutCopyMode = False
    Range("Tableau1[[#All],[Nom]:[Prénom]]").Select
    Selection.Copy
    Sheets("util").Select
    Range("H30").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("F30:F100").Select
    Selection.Cut Destination:=Range("F31:F50")
    Range("F31:F100").Select
    Sheets("bd").Select
    Range("Tableau1[Accompagnateurs]").Select
    Selection.Copy
    Sheets("util").Select
    Range("G30").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Cut Destination:=Range("G31:G50")
    Range("G31:G100").Select
    Sheets("bd").Select
    Range("Tableau1[[#Headers],[fin CDAPH]]").Select
    Selection.Copy
    Sheets("util").Select
    Range("F30").Select
    ActiveSheet.Paste
    Sheets("bd").Select
    Range("Tableau1[[#Headers],[Accompagnateurs]]").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("util").Select
    Range("G30").Select
    ActiveSheet.Paste
    Sheets("bd").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("bd").ListObjects("Tableau1").Sort.SortFields.Clear
    ActiveSheet.ShowAllData
    ActiveWorkbook.Worksheets("bd").ListObjects("Tableau1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("bd").ListObjects("Tableau1").Sort.SortFields.Add _
        Key:=Range("Tableau1[[#All],[Nom]]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("bd").ListObjects("Tableau1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("util").Select
    Range("D42").Select
End Sub

[Philippe Tulliez]

Bonjour,
La première chose à faire est d'éliminer les Select, Selection, Activate etc...
Même si l'enregisreur propose ce type de code, en VBA c'est parfaitement inutile et ralenti la procédure.
Par exemple
Ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sheets("util").Select
Range("F30:I446").Select
Selection.Delete Shift:=xlToLeft

Peut être avantageusement remplacé par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("util").Range("F30:I446").Delete Shift:=xlToLeft

De plus pour éviter tout au long des instructions de répéter plusieurs fois le nom du classeur, de feuilles ou d'autres objets, il est préférable de travailler avec des variables object.
Par exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim sht As Worksheet
 Set sht = ThisWorkbook.Worksheets("Util")
 sht.Range("F30:I446").Delete Shift:=xlToLeft

Ainsi la variable objet sht remplacera tout au long de la procédure la feuille "Util" du classeur où se trouve le code VBA (ThisWorkbook)

[MarcTer]

Merci je me lance dans le nettoyage !!!
@ bientôt
Marc