Bonjour,
je coince sur l'évoluation d'une macro que j'ai créée avec l'enregistreur.
Je voudrais rajouter une condition de couleur et de plus (255,255,0), je souhaiterai que ces couleurs restent (jaune et rouge) après le collage car actuellemnt tout se colorie en rouge !!! voici le code:
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
Sub alerte2()
'
' alerte2 Macro
'
 
'
    Application.ScreenUpdating = False
    Sheets("util").Range("F30:I446").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