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