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

batman666 · 3 Juillet 2010

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:

Recopier l'intégrale d'un onglet appelé DONNÉES
Renommer cet onglet sous la forme DONNÉES - DATE DU JOUR
EFfacer le bouton CRÉER UNE FEUILLES sur la nouvelle feuilles ains créé
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 :

Que l'onglet copié s'insère à la suite de l'onglet modèles
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 · 3 Juillet 2010

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é

Code:

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 · 4 Juillet 2010

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 · 4 Juillet 2010

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

Code:

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

Code:

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

Bonne soirée

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

batman666

XLDnaute Nouveau

JNP

XLDnaute Barbatruc

batman666

XLDnaute Nouveau

JNP

XLDnaute Barbatruc

Discussions similaires