Sub record()
Dim Mondico As Object
Dim J As Long, Nblg As Long
Dim Tablo
Dim Ws As Worksheet
Dim I As Integer

  Application.ScreenUpdating = False
  Set Ws = ActiveSheet
  Nblg = Range("C" & Rows.Count).End(xlUp).Row
  Set Mondico = CreateObject("Scripting.dictionary")
  For J = 4 To Nblg
    Mondico(Range("C" & J).Value) = ""
  Next J
  Tablo = Mondico.Keys
  Ws.Range("Q1") = Ws.Range("C3")
  For I = 0 To UBound(Tablo)
    Ws.Range("Q2") = Tablo(I)
    If FeuilleExiste(CStr(Tablo(I))) = False Then
      Sheets("Global").Copy after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Tablo(I)
    End If
    With Sheets(Tablo(I))
      .Rows("3:" & Rows.Count).ClearContents
      Ws.Range("A3:O" & Nblg).AdvancedFilter Action:=xlFilterCopy, criteriarange:=Ws.Range("Q1:Q2"), copytorange:=.Range("A3:O3")
    End With
  Next I
  Ws.Range("Q1:Q2").ClearContents
  Ws.Select
End Sub

Function FeuilleExiste(Nom As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(Nom).Name <> ""
  On Error GoTo 0
End Function