Liste automatique

Résolu/Fermé

juer31 Messages postés 109 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 4 octobre 2024 - 5 oct. 2017 à 19:24
juer31 Messages postés 109 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 4 octobre 2024 - 5 oct. 2017 à 20:59

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

A voir également:

Liste automatique
Liste déroulante excel - Guide
Recherche automatique des chaînes ne fonctionne pas - Guide
Message automatique thunderbird - Guide
Liste déroulante en cascade - Guide
Gmail libellé automatique - Guide

1 réponse

Réponse 1 / 1

via55 Messages postés 14494 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 26 octobre 2024 2 734
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 :

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

juer31 Messages postés 109 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 4 octobre 2024 6
5 oct. 2017 à 20:29

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?

via55 Messages postés 14494 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 26 octobre 2024 2 734 > juer31 Messages postés 109 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 4 octobre 2024
5 oct. 2017 à 20:40

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

juer31 Messages postés 109 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 4 octobre 2024 6 > via55 Messages postés 14494 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 26 octobre 2024
5 oct. 2017 à 20:59

Merci beaucoup

Très apprécier

Discussions similaires

Rechercher un numéro sur liste rouge

Annuaire inversé liste rouge