Macro pour une mise en forme conditionnelle

Bonjour à tous!

Malgré bien des recherches, je n'ai pas trouvé la réponse à ma question :

Voici donc : Je veux qu'un ensemble de cellules (de la colonne A à F) soient remplies en jaune si une donnée dans la colonne D = 08:00-20:00. Je ne veux pas toute la ligne, mais seulement la ligne entre les colonnes de A à F.

J'aimerais que la même mise en forme soit faite pour la donnée 08:00-16:00

J'aimerais le même processus mais avec le remplissage en bleu clair pour la donnée 20:00-08:00.

Mon fichier est joint.

J'ai essayé de faire enregistrer une macro, mais ça n'a pas fonctionné.

Merci à tous de l'aide que vous saurez m'apporter

Bonsoir,

je comprends pas pourquoi tu parle de macro ? tu n'a pas besoin de macro pour créer une mise en forme conditionnelle !

Je veux que le tout soit automatisé. Je pars avec une liste beaucoup plus grosse, et effectue une mise en forme via VBA

J'aimerais ajouter une étape supplémentaire à mon code pour mettre de la couleur à mon tableau. Voici le codage complet :

Sub RunAll()
    Call sbVBS_To_Delete_FirstFewColumns_in_Excel
    Call DeleteRowWithContents
    Call DeleteRowWithContents2
    Call Tri
    Call FindReplaceAllDundee
    Call FindReplaceAllTroutRiver
    Call FindReplaceAllHerdman
    Call FindReplaceAllCoveyHill
    Call FindReplaceAllHemmingford
    Call FindReplaceAll221
    Call FindReplaceAll223
    Call FindReplaceAllQuai
    Call FindReplaceAllSups
    Call largeur_colonnes
    Call Couleurs

  End Sub
Sub sbVBS_To_Delete_FirstFewColumns_in_Excel()
Columns(1).EntireColumn.Delete
Columns(3).EntireColumn.Delete
Columns(4).EntireColumn.Delete
Columns(4).EntireColumn.Delete
Columns(6).EntireColumn.Delete
Columns(6).EntireColumn.Delete
Columns(7).EntireColumn.Delete
End Sub
Sub DeleteRowWithContents()
'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "00:00-00:00" IN COLUMN C
'========================================================================
    Last = Cells(Rows.Count, "D").End(xlUp).Row
    For i = Last To 1 Step -1
        If (Cells(i, "D").Value) = "00:00-00:00" Then
            Cells(i, "A").EntireRow.Delete
        End If
    Next i
End Sub
Sub DeleteRowWithContents2()
'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "" IN COLUMN C
'========================================================================
    Last = Cells(Rows.Count, "D").End(xlUp).Row
    For i = Last To 1 Step -1
        If (Cells(i, "D").Value) = "" Then
               Cells(i, "A").EntireRow.Delete
        End If
    Next i
End Sub
Sub Tri()
'
' Tri Macro
'

'
    Range("E1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("E1:E33"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("E2:E33"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "330ASF1,307ASF1,302ASF1,311ASF1,333ASF1,324ASF1,341ASF1,358ASF1,3001TSOT,333SUPT1" _
        , DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Sub FindReplaceAllDundee()
'PURPOSE: Find & Replace text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant

fnd = "330ASF1"
rplc = "Dundee"

For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht

End Sub
Sub FindReplaceAllTroutRiver()
'PURPOSE: Find & Replace text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant

fnd = "307ASF1"
rplc = "Trout River"

For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht

End Sub
Sub FindReplaceAllHerdman()
'PURPOSE: Find & Replace text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant

fnd = "302ASF1"
rplc = "Herdman"

For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht

End Sub
Sub FindReplaceAllCoveyHill()
'PURPOSE: Find & Replace text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant

fnd = "311ASF1"
rplc = "Covey Hill"

For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht

End Sub
Sub FindReplaceAllHemmingford()
'PURPOSE: Find & Replace text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant

fnd = "333ASF1"
rplc = "Hemmingford"

For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht

End Sub
Sub FindReplaceAll221()
'PURPOSE: Find & Replace text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant

fnd = "324ASF1"
rplc = "Rte 221"

For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht

End Sub
Sub FindReplaceAll223()
'PURPOSE: Find & Replace text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant

fnd = "341ASF1"
rplc = "Rte 223"

For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht

End Sub
Sub FindReplaceAllQuai()
'PURPOSE: Find & Replace text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant

fnd = "358ASF1"
rplc = "Quai Richelieu"

For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht

End Sub
Sub FindReplaceAllSups()
'PURPOSE: Find & Replace text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant

fnd = "333SUPT1"
rplc = "Surintendants"

For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht

End Sub
Sub largeur_colonnes()
'
' largeur_colonnes Macro
'

'
    Columns("F:F").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("A:A").EntireColumn.AutoFit
    ActiveWindow.SmallScroll Down:=-3
End Sub