Liste automatique
Résolu
juer31
Messages postés
120
Statut
Membre
-
juer31 Messages postés 120 Statut Membre -
juer31 Messages postés 120 Statut Membre -
Bonjour,
J'ai cette macro qui crée une feuille a partir d'une liste mais si je mais la liste a jour et que j'exécute la macro a nouveau celui ci ne fonctionne pas. Pouvez-vous m'aider?
Merci
Sub ajout_feuilles()
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
Dim nom As String, c As Range
For Each c In Range("Projet")
nom = c.Value
If nom <> "" Then
Sheets.Add Count:=1, after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = nom
End If
Next c
End Sub
J'ai cette macro qui crée une feuille a partir d'une liste mais si je mais la liste a jour et que j'exécute la macro a nouveau celui ci ne fonctionne pas. Pouvez-vous m'aider?
Merci
Sub ajout_feuilles()
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
Dim nom As String, c As Range
For Each c In Range("Projet")
nom = c.Value
If nom <> "" Then
Sheets.Add Count:=1, after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = nom
End If
Next c
End Sub
1 réponse
-
Bonjour
La macro fonctionne la 1ere fois : normal
La macro ne fonctionne plus si on la relance : normal aussi car on ne peut pas recréer des feuilles avec le même nom
Donc si la liste appelée Projet a été modifiée en partie il faut pour chaque nom vérifier que le feuille n'existe pas déjà , en ce cas modifier la macro ainsi :Sub ajout_feuilles() With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With Dim nom As String, c As Range For Each c In Range("Projet") nom = c.Value If nom <> "" Then x = 0 For n = 1 To Sheets.Count If Sheets(n).Name = nom Then x = 1 Next n If x = 0 Then Sheets.Add Count:=1, after:=Worksheets(Worksheets.Count) ActiveSheet.Name = nom End If End If Next c End Sub
Cdlmnt
Via
-
Merci va fonctionne #1 cependant j'ai changer pour semblable mais cree un copie de modèle
Sub Creation_Onglets_Selon_Modele()
Dim c As Range
Application.ScreenUpdating = False
Set c = Worksheets("Suivi de projet").Range("B11") 'cellule de départ
Do Until IsEmpty(c)
Worksheets("Modèle").Copy after:=Worksheets(ThisWorkbook.Sheets.Count)
With Worksheets(ThisWorkbook.Sheets.Count)
.Name = c.Value
.Range("C1") = c.Value
.Range("C3") = Date
End With
Set c = c.Offset(1, 0)
Loop
Application.ScreenUpdating = True
End Sub
mais j'ai le même problème?
Peux tu m'aider?- Utilises la même macro que précédemment en remplaçant
Sheets.Add Count:=1, after:=Worksheets(Worksheets.Count) ActiveSheet.Name = nom
par tes instructions :Worksheets("Modèle").Copy after:=Worksheets(ThisWorkbook.Sheets.Count) With Worksheets(ThisWorkbook.Sheets.Count) .Name = c.Value .Range("C1") = c.Value .Range("C3") = Date End With
Via
-
