Option Compare Text 'la casse est ignorée (facultatif)
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not IsNumeric(Sh.Name) Then Exit Sub
Dim ts, t, i&, j As Byte, x$, k As Byte, P As Range, n&
ts = Sheets("EMP_PROP").Range("B" & Sh.Name).Resize(, 10)
With Sheets("EMP_WIN")
t = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)(2))
For i = 1 To UBound(t) - 11 Step 15 '-11 en cas de dernier tableau incomplet
For j = 1 To 10
x = t(i + j + 1, 1)
For k = 1 To 10
If x = ts(1, k) Then Exit For
Next
If k = 11 Then GoTo 1
Next
Set P = Union(.Rows(i).Resize(15), IIf(P Is Nothing, .Rows(i).Resize(15), P))
n = n + 1
1 Next
End With
If n Then P.Copy Sh.[A1]
Sh.Rows(15 * n + 1 & ":" & Sh.Rows.Count).Delete
End Sub