Option Explicit
Sub CpyAdmis()
If ActiveSheet.Name <> "Relevé de notes" Then Exit Sub
Dim sh As Worksheet, n1&, n2&, i&, j&, m%, k%
With ActiveSheet.ListObjects("Tableau1")
If .DataBodyRange Is Nothing Then Exit Sub
n1 = .ListRows.Count: If n1 = 0 Then Exit Sub
m = .ListColumns.Count: k = m - 3
End With
Set sh = Worksheets("Liste des admis")
j = 5: Application.ScreenUpdating = 0
n2 = sh.Cells(Rows.Count, 1).End(3).Row
If n2 > 4 Then sh.Range("A5:H" & n2).ClearContents
For i = 8 To n1 + 7
If Cells(i, m) = "Admis(e)" Then
Cells(i, 1).Resize(, 4).Copy: sh.Cells(j, 1).PasteSpecial -4163
Cells(i, k).Resize(, 4).Copy: sh.Cells(j, 5).PasteSpecial -4163
j = j + 1
End If
Next i
Application.CutCopyMode = 0: sh.Select: [A1].Select
End Sub