Sub transfert()
Application.DisplayAlerts = False
Dim sh As Worksheet
For Each sh In Worksheets
If sh.Index <> 1 Then sh.Delete
Next sh
With Feuil1
For c = 2 To .UsedRange.Rows.Count
fe = .Cells(c, 1)
If feuille(.Cells(c, 1)) = True Then
Sheets(fe).[A1:C1] = Array("Sexe", "Poids", "Taille")
Range(.Cells(c, 2), .Cells(c, 4)).Copy Sheets(fe).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Else
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = fe
End If
Next
End With
Application.DisplayAlerts = True
Set sh = Nothing
End Sub
Function feuille(a As String) As Boolean
For b = 2 To Sheets.Count
If Sheets(b).Name = a Then
feuille = True
Exit Function
End If
feuille = False
Next
End Function