Sub Macro_de_Test_IV()
Dim Rng As Range, c As Range, p As Range, x&, y&
seuil = 2.56
Application.ScreenUpdating = False
Set Rng = Sheets("Base").Columns("D:D").SpecialCells(xlCellTypeConstants, 1)
For Each c In Rng
Set p = c.CurrentRegion
x = p.Rows.Count
If IsError(Application.Match("SEUIL", p(1).Resize(x), 0)) Then
Exit Sub
Else
y = Application.Match("SEUIL", p(1).Resize(x), 0)
End If
If p.Item(y, 2) > seuil Then
p.Copy Sheets.Add(after:=Sheets(Sheets.Count)).Cells(1)
ActiveSheet.Name = "SEUIL_" & Format(c, "ddmmyyyy")
Application.CutCopyMode = False
End If
Set p = Nothing
Next
End Sub