Copie feuille modele avec changement nom

Bonjour,

en posant que la feuille "Modèle" est a l'extrême droite du classeur,
et que les feuilles semaines commence par la gauche en étant incrémenté
par la droite :

Sub CopieModele()

Dim Feuille As Worksheet
Dim NoSemaine As String
Dim Drapeau As Boolean

NoSemaine = "5": Drapeau = False
For Each Feuille In Worksheets
If (Feuille.Name = NoSemaine) Then
Drapeau = True
End If
Next Feuille

If Not (Drapeau) Then
Sheets("Modele").Copy Before:=Sheets("Modele")
ActiveSheet.Name = NoSemaine
End If

End Sub

mousnynao

Bonjour

J'ai un classeur avec une feuille modele et je voudrais copier ce modele
chaque lundi (si possible en automatique) en lui affectant un nom
correspondant au numero de semaine tout en sachant que si cette feuille
existe il ne faut pas la recréer.
Merci de votre aide
Cordialement

Bonjour,

Dans un module:

Sub auto_open()
nfeuille = "Sem" & noSemaine(Date)
If Not ExistFeuille(nfeuille) Then
Sheets("Modele").Copy After:=Sheets(Sheets.Count - 1)
ActiveSheet.Name = nfeuille
End If
End Sub

Function noSemaine(d As Date)
noSemaine = CInt(Format(d, "ww", vbMonday, vbFirstFourDays))
End Function

Function ExistFeuille(f)
ExistFeuille = False
For Each s In ActiveWorkbook.Sheets
If s.Name = f Then
ExistFeuille = True
End If
Next s
End Function

JB

Bonjour et merci à JB
Cela fonctionne mais j'ai un pb car je voudrais avoir le n° de semaine 09 et
non Sem09 car aprés j'utilise ce nom de feuille dans une cellule pour
afficher les dates de la semaine ( du ... au .....). Si je supprime le
Prefixe Sem dans le nom de la feuille pas de pb pour creer la feuille de la
semaine mais si je reviens dans le classeur le test de l'existence de la
feuille ne fonctionne pas et il y a bug.
Sauriez-vous m'aider.
Cordialement

Merci aussi à mousnynao pour sa réponse mais qui ne correspond pas
completement à mon attente

"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1141159846.327455.17380@p10g2000cwp.googlegroups.com...

Bonjour,

Dans un module:

Sub auto_open()
nfeuille = "Sem" & noSemaine(Date)
If Not ExistFeuille(nfeuille) Then
Sheets("Modele").Copy After:=Sheets(Sheets.Count - 1)
ActiveSheet.Name = nfeuille
End If
End Sub

Function noSemaine(d As Date)
noSemaine = CInt(Format(d, "ww", vbMonday, vbFirstFourDays))
End Function

Function ExistFeuille(f)
ExistFeuille = False
For Each s In ActiveWorkbook.Sheets
If s.Name = f Then
ExistFeuille = True
End If
Next s
End Function

JB

Sub auto_open()
nfeuille = CStr(noSemaine(Date))
If Not ExistFeuille(nfeuille) Then
Sheets("Modele").Copy After:=Sheets(Sheets.Count - 1)
ActiveSheet.Name = nfeuille
End If
End Sub

Function noSemaine(d As Date)
noSemaine = CInt(Format(d, "ww", vbMonday, vbFirstFourDays))
End Function

Function ExistFeuille(f)
ExistFeuille = False
For Each s In ActiveWorkbook.Sheets
If s.Name = f Then
ExistFeuille = True
End If
Next s
End Function

JB

Bonjour JB,

Quelque chose d'intéressant sur le bogue de la fonction format
telle que tu l'a utilisée à cette adresse :
http://support.microsoft.com/default.aspx?scid=kb;fr;200299

Function noSemaine(d As Date)
noSemaine = CInt(Format(d, "ww", vbMonday, vbFirstFourDays))
End Function


Salutations!