Liste automatique
Résolu/Fermé
juer31
Messages postés
107
Date d'inscription
mercredi 16 décembre 2015
Statut
Membre
Dernière intervention
25 mars 2024
-
5 oct. 2017 à 19:24
juer31 Messages postés 107 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 25 mars 2024 - 5 oct. 2017 à 20:59
juer31 Messages postés 107 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 25 mars 2024 - 5 oct. 2017 à 20:59
A voir également:
- Liste automatique
- Liste déroulante excel - Guide
- Message automatique thunderbird - Guide
- Réponse automatique outlook - Guide
- Recherche automatique des chaînes ne fonctionne pas - Guide
- Sommaire automatique word - Guide
1 réponse
via55
Messages postés
14402
Date d'inscription
mercredi 16 janvier 2013
Statut
Membre
Dernière intervention
18 avril 2024
2 702
5 oct. 2017 à 19:43
5 oct. 2017 à 19:43
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 :
Cdlmnt
Via
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
5 oct. 2017 à 20:29
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?
5 oct. 2017 à 20:40
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 WithVia
5 oct. 2017 à 20:59
Très apprécier