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