Faire évoluer une macro

**MarcTer** · 26/06/2013, 16h27

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

**SMBeccaria** · 26/06/2013, 21h57

Bonsoir,

pouvez vous poster le classeur afin que j'y vois plus clair svp ?

**MarcTer** · 02/07/2013, 07h39

Bonjour,
merci de t'interresser à mon pb.
voici le fichier demandé que j'ai tenté d'anonymiser ...
Je voudrai avoir sur l'onglet "util" l'ensemble des personnes colorier en jaune et rouge dans l'onglet "bd"
merci d'avance
cordialement
Marc

**SMBeccaria** · 02/07/2013, 12h04

Bonjour,

Essayez avec ce code à la place en remplacement de votre alerte2:

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
95
96
97
98
99
100
101
 
Sub alerte2()
'
' alerte2 Macro
 
    Application.ScreenUpdating = False
    Sheets("util").Select
    Sheets("util").Range("F30:I446").Delete Shift:=xlToLeft
 
    tableau_filter RGB(255, 0, 0)
    tableau_filter RGB(255, 255, 0)
 
    Sheets("bd").Select
    Range("Tableau1[[#Headers],[fin CDAPH]]").Select
    Selection.Copy
    Sheets("util").Select
    Range("F30:I30").Select
    ActiveSheet.Paste
    Range("G30") = "Nom"
    Range("H30") = "Prénom"
    Range("I30") = "Accompagnateurs"
'    sauvegarde
 
End Sub
 
 
 
Sub tableau_filter(mycriteria)
    Dim myrange As Range
 
    Sheets("bd").Select
    ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=13, Criteria1:= _
        "Présent"
    ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=10, Criteria1:= _
        mycriteria, 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 = mycriteria
    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
    Sheets("bd").Select
    Range("Tableau1[fin CDAPH]").Select
    Selection.Copy
    Sheets("util").Select
    Set myrange = ActiveSheet.Range("F31")
    Do Until myrange = "" And myrange.FormatConditions.Count = 0
        Set myrange = myrange.Offset(1)
    Loop
    myrange.Select
    ActiveSheet.Paste
    If mycriteria = RGB(255, 255, 0) Then
        myrange.Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.FormatConditions.Interior = RGB(255, 255, 0)
    End If
 
    Sheets("bd").Select
    Range("Tableau1[Nom]").Select
    Selection.Copy
    Sheets("util").Select
    Set myrange = Range("G31")
    Do Until myrange = "" And myrange.FormatConditions.Count = 0
        Set myrange = myrange.Offset(1)
    Loop
    myrange.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("bd").Select
    Range("Tableau1[Prénom]").Select
    Selection.Copy
    Sheets("util").Select
    Set myrange = Range("H31")
    Do Until myrange = "" And myrange.FormatConditions.Count = 0
        Set myrange = myrange.Offset(1)
    Loop
    myrange.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("bd").Select
    Range("Tableau1[Accompagnateurs]").Select
    Selection.Copy
    Sheets("util").Select
    Set myrange = Range("I31")
    Do Until myrange = "" And myrange.FormatConditions.Count = 0
        Set myrange = myrange.Offset(1)
    Loop
    myrange.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
End Sub

La mise en forme conditionnelle de la feuille util sur les colonnes F,G,H et I est elle indispensable ?

**MarcTer** · 04/07/2013, 14h25

Bonjour,
merci beaucoup. Je teste et vous dis.
et non je n'ai pas besoin de MFC sur les autres colonnes
@ bientôt
cordialement
Marc

Re bonjour,
je viens de tester ça bug ici :

Code :

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

Selection.FormatConditions.Interior = RGB(255, 255, 0)

je ne pige pas pourquoi et du coup comment corriger ...
merci pour l'aide
@+
Marc

**SMBeccaria** · 04/07/2013, 14h33

petite erreur de ma part, désolé.

Pouvez vous remplacer cette ligne par celle-ci:

Code :

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

Selection.Interior.Color = RGB(255, 255, 0)

**parmi** · 04/07/2013, 14h37

Bonjour,

Ce ne serait pas plutôt

Code :

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

Selection.FormatConditions.Interior.Color = RGB(255, 255, 0)

Faire évoluer une macro

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager