Création d'une macro avec cycle

Bonjour à tous,

Je vous sollicite car j'ai besoin d'aide pour une macro.

J'ai créé un fichier de départ dans lequel figure en feuille 1 un numéro de semaine (S45) et les jours se rapportant à celle-ci. J'ai mis en place une macro qui me permet de créer la semaine suivante : elle copie la feuille dans un nouvel onglet (feuille 2) et modifie le numéro de la semaine (S46) ainsi que les dates afférentes.
Jusqu'à cette étape cela fonctionne.

Mon problème, c'est que je souhaiterais ensuite depuis la feuille 2 (soit depuis la semaine 46) pouvoir créer la semaine 47 et ainsi de suite. Par contre, je ne sais pas comment faire car je débute en macro.

Je vous remercie par avance de votre aide.

Je vous adresse mon fichier de travail en pièce jointe pour que ce soit plus claire.Pièce jointe 582325

Bonjour
éviter .select dans tes futures programmation
ce que je propose
tu clic sur le bouton tu aura un message te demande de saisir le numéro de la semaine à créer ... si par erreur l'onglet dédié à cette semaine est déjà crée vous aurez un message t'informe de la situation et le traitement est annulé...si non un onglet sera créée avec ce numéro de semaine ayant comme nom S+numéro de semaine
la date du premier lundi de la semaine est déduite avec la formule :

Citation:

---

($C$2+(($B$2-1)*7))-((JOURSEM(($C$2+(($B$2-1)*7));2))-1)

---

NB : j'ai saisi le 01/01/2020 en C2 pour identifiée l'année : à mettre en blanc pour ne pas paraître ds tes fichiers
le mardi est bien évidemment lundi +1
code :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Sub test() Dim VALEUR As Long VALEUR = Application.InputBox("Merci de saisir le numéro de la semaine à créer : ", "titre le l'inputbox", , , , , , 1) 'le 1 impose du numérique. Voir l'aide pour trouver la bonne constante For i = 1 To Worksheets.Count If Worksheets(i).Name = "S" & VALEUR Then MsgBox ("Semaine existe déja !!! merci de vérifier !") Exit Sub End If Next i Sheets(2).Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = "S" & VALEUR ActiveSheet.Range("B2") = VALEUR End Sub

---

un fichier exemple à tester

Bonjour et merci beaucoup pour cette aide précieuse.

J'adore le fait de saisir directement le numéro de semaine souhaité pour créer la feuille c'est juste génial.
Je viens d'appliquer le code à mon fichier et c'est presque parfait à un détail prêt.

Je souhaite effacer le contenu du tableau (partie blanche).

Pouvez-vous m'aider sur ce dernier points ? Car j'utilisais le code ci-dessous mais je pense qu'il y a une manière plus propre de faire :

Code:

---

1 2 3 4

Range("C12").Select Range(Selection, Selection.End(xlDown)).Select Range("C12:G18").Select Selection.ClearContents

---

Je vous remercie beaucoup.

bonjour
j'ai porté qq modif tel que le rang de ton fichier masqué c'est pourquoi je recommande de travailler avec ce fichier joint
NB : j'ai ajouter le nettoyage de la zone blanche
à tester

Ok, je comprends la démarche mais j'ai encore une problématique.

Dans le cas ou j'ajoute une ligne dans le tableau la formule ne me permet pas de prendre l'intégralité du tableau.
J'ai ajouté une ligne en rang 15 mais du coup ma dernière ligne ne s'efface pas.

Merci encore

désolé, je comprends pas
explique avec un capture écran si non un fichier test sans données confid

Pardon effectivement si ça n'est pas clair.

J'ai ajouté en S45 une ligne comme si j'avais un nouveau collaborateur.
Lorsque je créé ma semaine suivante soit la S46 du coup l'ensemble ne s'efface pas.

Je vous adresse ci-joint le fichier.
Pièce jointe 582352

Merci encore de votre patience car je débute, mais j'ai bon espoir de me perfectionner au fil du temps.

parce que selon le code on copie toujours l'onglet initial

Code:

---

Sheets(2).Copy After:=Sheets(Sheets.Count)

---

pour copier le dernière feuille remplacer cette partie par

Code:

---

Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)

---

aussi la zone à nettoyer est variable donc à remplacer par :

Code:

---

1 2	nblig = 12 + ActiveSheet.Range("C8") - 1 ActiveSheet.Range("C12:G" & nblig).ClearContents

---

Génial, cela règle la problématique de l'ajout.

Par contre ma dernière ligne ne s'efface pas lors de la création de la nouvelle feuille.
Pièce jointe 582354

quelle dernière ligne?? ligne numéro combien svp ?
t'as pris en compte mon intervention du 14h:10

Code:

---

1 2	nblig = 12 + ActiveSheet.Range("C8") - 1 ActiveSheet.Range("C12:G" & nblig).ClearContents

---

Oui j'ai bien modifié le code avec les éléments communiqués mais ma dernière ligne ne s'efface toujours pas.
Je vous joint le fichier que vous puissiez constater car c'est peut être moi qui fait une erreur en reportant le code.

Pièce jointe 582363

Merci encore pour votre patience et votre aide.

à tester

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

Sub Semaine_suivante() Dim VALEUR As Long Dim nblig As Long VALEUR = Application.InputBox("Merci de saisir le numéro de la semaine à créer : ", "titre le l'inputbox", , , , , , 1) 'le 1 impose du numérique. Voir l'aide pour trouver la bonne constante For i = 1 To Worksheets.Count If Worksheets(i).Name = "S" & VALEUR Then MsgBox ("Semaine existe déja !!! merci de vérifier !") Exit Sub End If Next i Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = "S" & VALEUR ActiveSheet.Range("B2") = VALEUR nblig = (12 + CDbl(ActiveSheet.Range("C8").Value) - 1) MsgBox nblig ActiveSheet.Range("C12:G" & nblig).ClearContents End Sub

---

C'est parfait, mon problème est solutionné.

J'ai juste supprimé la ligne de code: MsgBox nblig
Le contenu des cellules est effacé sans passer par la fenêtre de validation.

Je vous remercie beaucoup pour votre aide précieuse et vous souhaite une agréable fin de journée. :D

ton fichier a tester