[COLOR="DarkSlateGray"][B]Sub toto()
Dim oDat, i&
Application.ScreenUpdating = False
On Error GoTo E
With Sheets("Feuil1")
oDat = Intersect(.Range(.Range("A2"), .Range("A2").SpecialCells(xlCellTypeLastCell)), .Columns("A:B")).Value
End With
On Error GoTo 0
If IsEmpty(oDat) Then GoTo E
For i = 1 To UBound(oDat, 1)
If oDat(i, 1) & "-" & oDat(i, 2) <> "-" Then
Application.Worksheets.Add After:=Me
On Error GoTo S
ActiveSheet.Name = Format(oDat(i, 1), "0000") & "-" & oDat(i, 2)
On Error GoTo 0
End If
Next i
E: Application.ScreenUpdating = True
Exit Sub
'
S: Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Resume Next
End Sub[/B][/COLOR]