Copie d'un onglet existant avec ajout de date dans le nom de l'onglet

[batman666]

Bonjour,

En lisant à gauche et à droite sur ce forum, je suis parvenu à créer la macro suivante 🙂 qui, associé à un bouton de la feuilles DONNÉES, fait presque ce que je veux c.-à-d:

1. Recopier l'intégrale d'un onglet appelé DONNÉES
2. Renommer cet onglet sous la forme DONNÉES - DATE DU JOUR
3. EFfacer le bouton CRÉER UNE FEUILLES sur la nouvelle feuilles ains créé
4. Ajouter un bouton DÉTRUIRE LA FEUILLES (qui est associée à une autre macro qui permet de détruire la feuilles créée en cas d'erreur

Le hic c'est que ma macro permet de recopier l'onglet mais 🙁dans une autre classeur. Or, je souhaite :😀

1. Que l'onglet copié s'insère à la suite de l'onglet modèles
2. Que cette insertion ce fasse de manière chronologique, par exemple DONNÉES (feuille originale) soit suivi par DONNÉES - 2010-07-03 et éventuellement par DONNÉES - 2010-07-04
   

Voici la macro dont il est question, Je crois que mon problème se situent dans la section que j'ai volontairement mis en rouge

Sub AJOUTDONNÉES()

' Déprotéger le classeur et la feuilles
ActiveWorkbook.Unprotect ("XXX")
ActiveSheet.Unprotect ("XXX")
'
' Copie feuilles DONNÉES
Range("A1:K34").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("DONNÉES").Select
Sheets("DONNÉES").Copy
Application.WindowState = xlMinimized
ActiveSheet.Select

' Lecture de la du jour en vue de renomme l'onglet

Range("I5").Select ' Positionnement du curseur en I5
'Lecture de la date du jour actuel en I1 (date du système par formule =MAINTENANT())
DateJour = Range("A49").Value
' Extraction de JJ-MM-AAAA Le nom de feuille n'accepte pas les /
JourDate = Left(DateJour, 4) & "-" & Mid(DateJour, 6, 2) & "-" & Mid(DateJour, 9, 2)
ActiveSheet.Name = "DONNÉES" & JourDate ' Attribution du nom de la nouvelle feuille
ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
Application.ScreenUpdating = True ' Enables screen refreshing.

' effacer le bouton créer

ActiveSheet.Shapes("Button 1").Select
Selection.Cut


' création du bouton détruire

ActiveSheet.Buttons.Add(201, 717, 282.75, 24.75).Select
Selection.OnAction = "KillNewDonnées"
ActiveSheet.Shapes("Button 3").Select
Selection.Characters.Text = "DÉTRUIRE CETTE FEUILLE"
With Selection.Characters(Start:=1, Length:=23).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With


With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With

' Renommer l'onglet

ActiveSheet.Shapes("Picture 2").Select
Selection.Cut
ActiveSheet.Shapes("Button 3").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft -20.25
Selection.ShapeRange.IncrementTop 4.5
Range("G34").Select

' Protection de la nouvelle feuilles ainsi créé
ActiveSheet.Protect ("8idu11e2")
ActiveWorkbook.Protect ("8idu11e2")

End Sub​

Avez-vous des idées pour m'aider

 

[JNP]

Re : Copie d'un onglet existant avec ajout de date dans le nom de l'onglet

Bonsoir Batman666 🙂,
Pas vraiment sûr d'avoir compris, mais essaie ce code modifié

Sub AJOUTDONNÉES()
' Déprotéger le classeur et la feuilles
ActiveWorkbook.Unprotect ("XXX")
ActiveSheet.Unprotect ("XXX")
Application.ScreenUpdating = False ' Stoppe screen refreshing.
' Copie feuilles DONNÉES
Range("A1:K34").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("DONNÉES").Copy after:=Sheets("DONNÉES")
Application.WindowState = xlMinimized
' Extraction de JJ-MM-AAAA Le nom de feuille n'accepte pas les /
JourDate = Format(Now(), "dd-mm-yyyy")
ActiveSheet.Name = "Aigu-2007 " & JourDate ' Attribution du nom de la nouvelle feuille
'...
Application.ScreenUpdating = True ' Rétablie screen refreshing.
End Sub

Bonne soirée 😎

 

[batman666]

Re : Copie d'un onglet existant avec ajout de date dans le nom de l'onglet

Excellente solution😀

Avec quelques ajustements, ta macro fait exactement ce que je veux. Voici donc la version finale :

ActiveWorkbook.Unprotect ("XXXX")
ActiveSheet.Unprotect ("XXXX")
Application.ScreenUpdating = False ' Stoppe screen refreshing.

'
Range("A1:K34").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("DONNÉES").Copy after:=Sheets("DONNÉES")
Application.WindowState = xlMaximized
ActiveSheet.Select


Range("I5").Select ' Positionnement du curseur en I5
'Lecture de la date du jour actuel en I1 (date du système par formule =MAINTENANT())
DateJour = Range("A49").Value
' Extraction de JJ-MM-AAAA Le nom de feuille n'accepte pas les /
JourDate = Left(DateJour, 4) & "-" & Mid(DateJour, 6, 2) & "-" & Mid(DateJour, 9, 2)
ActiveSheet.Name = "Aigu-2007 " & JourDate ' Attribution du nom de la nouvelle feuille
ActiveSheet.Move after:=Sheets(ActiveWorkbook.Sheets.Count)
Application.ScreenUpdating = True ' Enables screen refreshing.

Merci beaucoup à toi pour le coup de pouce

 

[JNP]

Re : Copie d'un onglet existant avec ajout de date dans le nom de l'onglet

Re 🙂,
Tant mieux si c'est bon, par contre, pourquoi n'as-tu pas pris

JourDate = Format(Now(), "dd-mm-yyyy")

J'ai vu qu'en commentaire, tu mettais JJ-MM-AAAA, mais je viens de m'apercevoir que ton code prenais (à priori) AAAA-MM-JJ, soit tout simplement

JourDate = Format(Now(), "yyyy-mm-dd")

Bonne soirée 😎