Sub test()
Dim i%, k%, tmp$, prout%
Application.ScreenUpdating = False
With Sheets("Base")
'suppression des onglets existant deja
For k = Sheets.Count To 1 Step -1
tmp = Sheets(k).Name
If tmp <> "Formulaire" And tmp <> "Base" And Left(tmp, 7) Like Sheets(k).[B2].Value & "*" Then
Application.DisplayAlerts = False
Sheets(k).Delete
Application.DisplayAlerts = True
End If
Next k
'boucle sur le nombre d'individus
For i = 2 To .Range("A65536").End(xlUp).Row
'création de l'onglet à partir de l'onglet vierge Formulaire
Sheets("Formulaire").Copy After:=Sheets(Sheets.Count)
prout = 0
On Error GoTo E
ActiveSheet.Name = .Cells(i, 2).Value & IIf(prout, "_" & prout, "")
On Error GoTo 0
.Range(.Cells(i, 1), .Cells(i, 28)).Copy
ActiveSheet.Range("B1").PasteSpecial Paste:=xlValues, Transpose:=True
Next i
End With
Application.ScreenUpdating = True
Exit Sub
E:
prout = prout + 1 - (prout = 0)
Resume
End Sub