Simplification de macro

Bonjour,

j'ai la macro suivante, qui est très répétitive:

Sub LD2()
Dim TF As Variant 
Dim L As String  
Dim PL1 As Range 
Dim PL2 As Range
Dim PL3 As Range
Dim PL4 As Range
Dim CEL As Range

TF = Array("min", "h", "s") 

L = "h, min, s" 

Set PL1 = Sheets("Tr").Range("Y1:Y" & Range("Y" & Rows.Count).End(xlUp).Row) 'Déclaration de la plage PL1
For Each CEL In PL1 
     For i = 0 To UBound(TF)
    If InStr(1, CEL.Value, TF(i), vbTextCompare) <> 0 Then 
        With CEL.Validation 
            .Delete 
            .Add Type:=xlValidateList, Formula1:=L 
    End If
    Next i
Next CEL

Set PL2 = Sheets("Tm").Range("Y1:Y" & Range("Y" & Rows.Count).End(xlUp).Row)
For Each CEL In PL2
For i = 0 To UBound(TF)
    If InStr(1, CEL.Value, TF(i), vbTextCompare) <> 0 Then
        With CEL.Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=L
        End With
    End If
    Next i
Next CEL

Set PL3 = Sheets("Mes").Range("Y1:Y" & Range("Y" & Rows.Count).End(xlUp).Row)
For Each CEL In PL3
    For i = 0 To UBound(TF)
    If InStr(1, CEL.Value, TF(i), vbTextCompare) <> 0 Then
        With CEL.Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=L
        End With
    End If
    Next i
Next CEL

Set PL4 = Sheets("Regul").Range("Y1:Y" & Range("Y" & Rows.Count).End(xlUp).Row)
For Each CEL In PL4
For i = 0 To UBound(TF)
    If InStr(1, CEL.Value, TF(i), vbTextCompare) <> 0 Then
        With CEL.Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=L
        End With
    End If
    Next i
Next CEL
End Sub

J'aimerais en faire une macro plus "générique", et moins lourde.

Merci d'avance,

Cordialement

FGR

Bonjour,

à tester,

Sub LD2()
Dim TF As Variant
Dim L As String
Dim PL As Range
Dim CEL As Range
Dim i As Integer, y As Integer

TF = Array("min", "h", "s")
sh = Array("Tr", "Tm", "Mes", "Regul")
L = "h, min, s"

For y = 0 To 3
 Set PL = Sheets(sh(i)).Range("Y1:Y" & Range("Y" & Rows.Count).End(xlUp).Row) 'Déclaration de la plage PL1
  For Each CEL In PL
     For i = 0 To UBound(TF)
       If InStr(1, CEL.Value, TF(i), vbTextCompare) <> 0 Then
        With CEL.Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=L
        End With
       End If
    Next i
  Next CEL
Next y
End Sub

Bonsoir,