Private Sub Copier_Nommer_Feuilles()
Dim oDat, i As Long
Call Test2
30 With [A20] 'Cellule à partir de laquelle sont placés les noms des feuilles _
à créer. Il peut y en avoir autant qu'on veut.
40 If Cells(Rows.Count, .Column).End(xlUp).Cells(1, 1).Row < .Row Then GoTo E
'Si toutes les cellules en-dessous de B11 sont vides, aller à E _
(c'est-à-dire ne rien faire).
50 With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
'Ligne "technique" pour accélérer l'exécution.
60 oDat = Range(.Cells.Offset(-1, 0), Cells(Rows.Count, .Column).End(xlUp)).Value
'Place dans le tableau oDat (une colonne) les valeurs de B11 à Bn, _
où n est le numéro de la dernière ligne non vide de la colonne B.
70 For i = 2 To UBound(oDat, 1) 'Pour i variant de 2 au nombre de lignes _
du tableau oDat...
If [d20].Offset(i - 2).Value = "X" Then 'On ne traite que les lignes avec périodicité
75 On Error GoTo m 'Pour sortir de la procédure si la feuille modèle _
n'existe pas.
80 Sheets("Feuille_modèle").Copy After:=Sheets(Sheets.Count) 'Ajoute une copie _
de la feuille "Feuille_modèle" à la fin du classeur.
85 Sheets(Sheets.Count).[B2].Value = CStr(oDat(i, 1)) 'No comment.
90 On Error GoTo S 'Si une erreur se produit dans la ligne qui _
suit, elle est ignorée, et l'exécution continue à la ligne _
suivante après le traitement de l'erreur (ligne S).
100 Sheets(Sheets.Count).Name = CStr(oDat(i, 1)) '...renomme _
la feuille créée avec le nom qui est dans la ligne i de la _
première colonne du tableau oDat. Si une valeur est manquante _
dans le tableau oDat ou si ce nom existe déjà dans le classeur, _
une erreur se produit. Grâce à la ligne 90 cette erreur est _
ignorée et l'exécution du code continue.
110 On Error GoTo 0 'A partir d'ici, les éventuelles erreurs ne sont plus _
ignorées.
End If
120 Next 'Reprendre l'exécution à la ligne 75 avec la valeur suivante de i, _
tant que la dernière ligne du tableau oDat n'est pas atteinte.
130 With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
'Ligne "technique" pour rétablir les paramètres modifiés à la ligne 5. _
Le code fonctionne aussi si les lignes 5 et 14 sont supprimées, mais _
l'exécution est plus lente.
E: End With
Exit Sub
m: MsgBox "Le nom de la feuille modèle est incorrect.": Resume E
'Suppression de la feuille créée si une erreur survient ligne 100.
S: With Application: .DisplayAlerts = False: Sheets(Sheets.Count).Delete: .DisplayAlerts = True: End With
Resume Next
End Sub
31, comme dans l'exemple , les fichiers crées seront dans la cellellules A21/A24/A28,
