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
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Mousnynao
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,
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
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
JB
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,
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
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
philippe
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" a écrit dans le message de news:
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
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" a écrit dans le message de news:
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
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
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
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
michdenis
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!
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
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