Sub seq()
Dim OS As Worksheet
Dim OD As Worksheet
Set OS = Worksheets("Em")
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Seq"
Set OD = ActiveSheet
OD.Range("A1").Value = "NumT"
OD.Range("B1").Value = "NumSeq"
OD.Range("C1").Value = "NumPass"
OD.Range("D1").Value = "TempfinSeq"
DernLigne = OS.Range("A" & Rows.Count).End(xlUp).Row
j = 2
For i = 2 To DernLigne
If OS.Range("B" & i + 1).Value = OS.Range("B" & i).Value Then
If OS.Range("C" & i).Value = 1 Then
ml = WorksheetFunction.Max(OS.Range("C2:C" & DernLigne))
ligne = OS.Columns(3).Find(ml, , xlValues, xlWhole).Row
Sheets("Seq").Range("A" & j).Value = Sheets("Em").Range("A" & ligne).Value
Sheets("Seq").Range("B" & j).Value = Sheets("Em").Range("B" & ligne).Value
Sheets("Seq").Range("C" & j).Value = Sheets("Em").Range("C" & ligne).Value
Sheets("Seq").Range("C" & j).Value = Sheets("Em").Range("D" & ligne).Value
j = j + 1
End If
End If
Next i
End Sub