Sub ongletparunivers()
Application.ScreenUpdating = False
Dim cell As Range, Nom$, Sht As Worksheet
Dim base As String
Dim fin2 As Integer
Dim lettre As String
Dim numero As Integer
lettre = InputBox('lettre de la ligne des fournisseurs')
numero = InputBox('ligne des titres') + 1
fin2 = Range(lettre & numero).End(xlDown).Row
base = ActiveSheet.Name
Range(lettre & numero & ':' & lettre & fin2).Select
'fin = Selection.Rows.Count
For Each cell In Selection
Nom = cell.Value
If Nom <> '' Then
On Error Resume Next
Set Sht = Sheets(Nom)
On Error GoTo 0
If Sht Is Nothing Then Sheets.Add.Name = Nom
End If
Next cell 'fin de la créa des onglets
For i = numero To fin2 'détermination de la boucle pour coller l'entete dans chaque onglet
Nom = Worksheets(base).Range(lettre & i).Value
If Nom <> '' Then On Error Resume Next
Worksheets(base).Range('A1:' & lettre & numero - 1).EntireRow.Copy
Sheets(Nom).Activate
ActiveSheet.Range(lettre & '1').PasteSpecial
Next
For i = numero To fin2 'détermination de la boucle pour coller toutes les valeurs relative en fontion du nom
Nom = Worksheets(base).Range(lettre & i).Value
If Nom <> '' Then On Error Resume Next
Worksheets(base).Range(lettre & i).EntireRow.Copy
Sheets(Nom).Activate
ActiveSheet.Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial
Next
ActiveSheet.Range('A1').Select
Application.ScreenUpdating = True
End Sub