Bonjour,

Ci-après une macro qui fonctionne. J'aimerai votre avis sur l'existence d'une alternative - faire la même chose mais avec une méthode / approche différente - qui serait plus académique ou plus courte ou "plus mieux" ...
J'ai mis en forme des bouts de codes à l'aide de l'enregistreur de macro et des discussions du forum, et donc suis preneur de tuyaux ... merci par avance pour votre retour



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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
 Sub Macro1()
Application.ScreenUpdating = False
ActiveSheet.Name = "R"
Cells.Select
    With Selection
    .HorizontalAlignment = xlGeneral
    End With
    With Selection
    .HorizontalAlignment = xlCenter
    End With
 
Dim Plage As Range
Dim C As Range
Dim Row As Range
Dim LastLig As Long
Dim i As Long
 
 
'mise en forme des colonnes 
 
With Sheets("R")
.Rows("1:1").RowHeight = 48
.Columns("A:A").ColumnWidth = 5.86
.Columns("E:E").ColumnWidth = 25.86
.Columns("F:F").ColumnWidth = 19.14
.Columns("G:G").ColumnWidth = 11.29
.Columns("H:H").ColumnWidth = 11.57
.Columns("K:K").ColumnWidth = 5.29
.Columns("S:S").ColumnWidth = 33.57
End With
 
'mise sous forme de tableau 
 
With Sheets("R")
.ListObjects.Add(xlSrcRange, [A2].CurrentRegion, xlYes).Name = "Tableau1"
.ListObjects("Tableau1").TableStyle = "TableStyleMedium6"
'.ListObjects("Tableau1").Sort.SortFields.Clear
'.ListObjects("Tableau1").Sort.SortFields.Add Key:=Range("Tableau1[[#All],[Age]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlNormal
End With
 
'niveau de rémunération  
With Sheets("R")
LastLig = Range("E" & Rows.Count).End(xlUp).Row
 
For i = LastLig To 2 Step -1
 
If .Range("E" & i).Text Like "" Then .Range("E" & i).Interior.ColorIndex = 3
 
Next i
End With
 
'présence de prix
With Sheets("R")
 
LastLig = Range("G" & Rows.Count).End(xlUp).Row
 
For i = LastLig To 2 Step -1
 
If .Range("G" & i).Text = "NON" Then .Range("G" & i).Interior.ColorIndex = 3
Next i
End With
 
'disponibilité 
With Sheets("R")
 
LastLig = Range("H" & Rows.Count).End(xlUp).Row
 
For i = LastLig To 2 Step -1
If .Range("H" & i).Text Like "*pas dispo*" Then .Range("H" & i).Interior.ColorIndex = 3        
Next i
End With
 
'prospection 
With Sheets("R")
 
Set Plage = .Range("J2:J" & .Range("J" & .Rows.Count).End(xlUp).Row)
 
For Each C In Plage
 
If C.Value = "ETAB" Then
If ((C.Offset(0, 1).Value Like "*A jour*") Or (C.Offset(0, 1).Value Like "*A voir *") Or (C.Offset(0, 1).Value Like "*Relance*")) Then
C.Offset(0, 1).Interior.Color = vbRed
End If
End If
 
Next C
Set Plage = Nothing
 
End With
 
'âge apprenti inférieur à 26 ans 
 
With Sheets("R")
 
Set Plage = .Range("R2:R" & .Range("R" & .Rows.Count).End(xlUp).Row)
 
For Each C In Plage
If C.Value < 26 Then C.Interior.Color = vbCyan
 
Next C
Set Plage = Nothing
 
End With
 
 
'Plan d’actions vide
 
With Sheets("R")
 
Set Plage = .Range("S2:S" & .Range("S" & .Rows.Count).End(xlUp).Row)
 
For Each C In Plage
If C.Value = "" Then C.Interior.Color = vbCyan
 
Next C
Set Plage = Nothing
 
End With
Application.ScreenUpdating = True
End Sub