Sub test()
Dim i%, k%
Application.ScreenUpdating = False
With Sheets("BDD")
'suppression des onglets existant deja
For k = Sheets.Count To 1 Step -1
If Left(Sheets(k).Name, 7) = "Contact" 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)
ActiveSheet.Name = "Contact_" & i - 1
.Range(.Cells(i, 2), .Cells(i, 9)).Copy
Sheets("Contact_" & i - 1).Range("B2").PasteSpecial Paste:=xlValues, Transpose:=True
Next i
End With
Application.ScreenUpdating = True
End Sub