Sub Equipes()
Dim fichier$, feuille$, plage As Range, c As Range, w As Worksheet
fichier = "calendrier_test.xlsm" 'à adapter
feuille = "calendrier"
On Error Resume Next
Set plage = Workbooks(fichier).Sheets(feuille).[A1].CurrentRegion
If plage Is Nothing Then MsgBox "Le fichier '" & fichier & "' doi être ouvert et contenir la feuille '" & feuille & "'": Exit Sub
Application.ScreenUpdating = False
For Each c In Sheets("liste").[A3:A20] 'à adapter
If c <> "" Then
'---création de la feuille---
On Error Resume Next
Set w = Nothing
Set w = Sheets(c.Value)
On Error GoTo 0
If w Is Nothing Then
Set w = Sheets.Add(After:=Sheets(Sheets.Count))
w.Name = c
End If
'---filtre avancé copié---
w.Cells.Delete 'RAZ
plage(2, 7) = "=OR(B2=""" & c & """,D2=""" & c & """)" 'critère
plage.AdvancedFilter xlFilterCopy, plage(1, 7).Resize(2), w.Range("A1:E1")
End If
Next
If plage.Parent.FilterMode Then plage.Parent.ShowAllData 'RAZ
plage(2, 7) = "" 'RAZ
Sheets("liste").Activate
End Sub