Boucle - Création d'onglet

ROGER2327 à dit:

Bonjour MERLIN

Essayez cette procédure :

Code:

[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]

À placer de le module de la feuille Feuil1" ou dans un module standard.​

ROGER2327
#3221

Cliquez pour agrandir...