XL 2013 Création bouton de copie

K

Kath

XLDnaute Nouveau
Hello tout le monde, j'ai besoin de votre aide ;)
En fait j'ai un classeur avec des onglets numérotés de 01 à 31

et j'aimerai que sur chaque feuille il y'ait un bouton qui copie la feuille précédente sans copier les cellules H2 et H3.
Pourriez vous m'aider svp!
D'avance Merci
 
Trier par date Trier par votes
K

Kath

XLDnaute Nouveau
job75 à dit:
Re, salut vmax01,

Le titre de ce fil c'est Création bouton de copie non ???

Alors voyez le fichier joint avec ces 2 macros dans ThisWorkbook et Module1 :
Code: 
Private Sub Workbook_Open()
Dim w As Worksheet, o As Object
For Each w In Worksheets
    If w.Name Like "##" Then
        For Each o In w.DrawingObjects
            If o.OnAction Like "*MAJ" Then GoTo 1
        Next
        With w.[E2:E3]
            With w.Buttons.Add(.Left, .Top, .Width, .Height)
                .Text = "MAJ"
                .Font.Bold = True 'gras
                .OnAction = "MAJ"
            End With
        End With
    End If
1 Next
End Sub
Code: 
Sub MAJ()
Dim prem$, mem, o
prem = "30.11.18" 'à adapter
With ActiveSheet
    If Not .Name Like "##" Then Exit Sub
    mem = .[H2:H3].Formula
    Application.ScreenUpdating = False
    For Each o In .DrawingObjects
        If o.TopLeftCell.Address <> "$E$2" Or .Name <> "01" Then o.Delete 'suppression des objets
    Next
    Sheets(IIf(.Name = "01", prem, Format(Val(.Name) - 1, "00"))).Cells.Copy .[A1] 'copie les cellules et les objets
    .[H2].Copy .[H2] 'vide la mémoire
    .[H2:H3] = mem
End With
End Sub
Les boutons sont créés à l'ouverture du fichier dans chaque feuille quand ils n'existent pas.

La macro MAJ leur est affectée.

A+[/QUOTE
Wouah en fait je n'étais pas prête de m'en sortir je te remercie pour ce super travail ;) c'est ce qu'il me fallait avec le bouton et tout super cool merci beaucoup :)
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
K

Kath

XLDnaute Nouveau
job75 à dit:
Re, salut vmax01,

Le titre de ce fil c'est Création bouton de copie non ???

Alors voyez le fichier joint avec ces 2 macros dans ThisWorkbook et Module1 :
Code: 
Private Sub Workbook_Open()
Dim w As Worksheet, o As Object
For Each w In Worksheets
    If w.Name Like "##" Then
        For Each o In w.DrawingObjects
            If o.OnAction Like "*MAJ" Then GoTo 1
        Next
        With w.[E2:E3]
            With w.Buttons.Add(.Left, .Top, .Width, .Height)
                .Text = "MAJ"
                .Font.Bold = True 'gras
                .OnAction = "MAJ"
            End With
        End With
    End If
1 Next
End Sub
Code: 
Sub MAJ()
Dim prem$, mem, o
prem = "30.11.18" 'à adapter
With ActiveSheet
    If Not .Name Like "##" Then Exit Sub
    mem = .[H2:H3].Formula
    Application.ScreenUpdating = False
    For Each o In .DrawingObjects
        If o.TopLeftCell.Address <> "$E$2" Or .Name <> "01" Then o.Delete 'suppression des objets
    Next
    Sheets(IIf(.Name = "01", prem, Format(Val(.Name) - 1, "00"))).Cells.Copy .[A1] 'copie les cellules et les objets
    .[H2].Copy .[H2] 'vide la mémoire
    .[H2:H3] = mem
End With
End Sub
Les boutons sont créés à l'ouverture du fichier dans chaque feuille quand ils n'existent pas.

La macro MAJ leur est affectée.

A+[/QUOTE
job75 à dit:
Re, salut vmax01,

Le titre de ce fil c'est Création bouton de copie non ???

Alors voyez le fichier joint avec ces 2 macros dans ThisWorkbook et Module1 :
Code: 
Private Sub Workbook_Open()
Dim w As Worksheet, o As Object
For Each w In Worksheets
    If w.Name Like "##" Then
        For Each o In w.DrawingObjects
            If o.OnAction Like "*MAJ" Then GoTo 1
        Next
        With w.[E2:E3]
            With w.Buttons.Add(.Left, .Top, .Width, .Height)
                .Text = "MAJ"
                .Font.Bold = True 'gras
                .OnAction = "MAJ"
            End With
        End With
    End If
1 Next
End Sub
Code: 
Sub MAJ()
Dim prem$, mem, o
prem = "30.11.18" 'à adapter
With ActiveSheet
    If Not .Name Like "##" Then Exit Sub
    mem = .[H2:H3].Formula
    Application.ScreenUpdating = False
    For Each o In .DrawingObjects
        If o.TopLeftCell.Address <> "$E$2" Or .Name <> "01" Then o.Delete 'suppression des objets
    Next
    Sheets(IIf(.Name = "01", prem, Format(Val(.Name) - 1, "00"))).Cells.Copy .[A1] 'copie les cellules et les objets
    .[H2].Copy .[H2] 'vide la mémoire
    .[H2:H3] = mem
End With
End Sub
Les boutons sont créés à l'ouverture du fichier dans chaque feuille quand ils n'existent pas.

La macro MAJ leur est affectée.

A+
Cliquez pour agrandir...
Cliquez pour agrandir...
job75 à dit:
Bonjour Kath, bienvenue sur XLD,

Si l'on met un bouton dans l'onglet '01' il doit copier quoi ???

A+
Cliquez pour agrandir...

Job75 est ce possible de créer les onglets avec le tableau et le logo uniquement dans un premier temps?
Et d'ajouter en N12 une fois toutes les feuilles faites, le bouton MAJ ?
J'ai essayé de trafiquer tes codes mais je me suis vite perdue ;)
 
Dernière édition:
Vote positif 0 Vote négatif
vmax01

vmax01

XLDnaute Occasionnel
bonjour Kath, job75 et le forum

change le code actuel pas celui-là en sachant qu'il va falloir renommer le nom "shapes" dans le code pare le nom de te ton logo pour que cela soit pris en compte
Code: 
Sub MB()
Application.ScreenUpdating = False
For jour = DateSerial(Year(Date), Month(Date), 1) To DateSerial(Year(Date), Month(Date) + 1, 0)
    Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = Format(jour, "dd")
    Sheets("modele").Cells.Copy
    Cells.PasteSpecial
    Sheets("modele").Shapes("Image A DEFINIRE").Copy
    [A1].PasteSpecial
    Cells(2, 8) = "Date"
    Cells(3, 8) = Format(jour, "mm/dd/yyyy")
Next jour
Application.ScreenUpdating = True
' ActiveWorkbook.Save
End Sub

Bonne journée.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Kath, vmax01,

Bon puisqu'on pousse à la consommation voyez le fichier (2) et cette macro :
Code: 
Sub CreationMois()
Dim mois$, w As Worksheet, F As Worksheet, vis, n
Do
    mois = InputBox("Numéro du mois et année du mois à créer :", "Création du mois", Format(Date, "m/yy"))
    If mois = "" Then Exit Sub
Loop While Not IsDate("1/" & mois)
mois = "1/" & mois
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---RAZ---
For Each w In Worksheets
    If w.Name Like "##" Then w.Delete
Next
'---création des feuilles---
Set F = Sheets("modele")
vis = F.Visible
F.Visible = xlSheetVisible 'si la feuille est masquée
Application.Goto F.[A1], True 'cadrage
For n = 1 To Day(DateSerial(Year(mois), Month(mois) + 1, 0))
    F.Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = Format(n, "00")
    Sheets(Sheets.Count).[H3] = DateSerial(Year(mois), Month(mois), n)
Next
F.Visible = vis 'état initial
Sheets("Accueil").Activate
End Sub
La feuille modele est masquée et j'ai ajouté la feuille Accueil.

J'ai laissé les autres macros mais la création des boutons "MAJ" paraît assez peu utile...

A+
 

Pièces jointes

  • Exemple(2).xlsm
    50.1 KB · Affichages: 13
Dernière édition:
Vote positif 0 Vote négatif
K

Kath

XLDnaute Nouveau
vmax01 à dit:
bonjour Kath, job75 et le forum

change le code actuel pas celui-là en sachant qu'il va falloir renommer le nom "shapes" dans le code pare le nom de te ton logo pour que cela soit pris en compte
Code: 
Sub MB()
Application.ScreenUpdating = False
For jour = DateSerial(Year(Date), Month(Date), 1) To DateSerial(Year(Date), Month(Date) + 1, 0)
    Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = Format(jour, "dd")
    Sheets("modele").Cells.Copy
    Cells.PasteSpecial
    Sheets("modele").Shapes("Image A DEFINIRE").Copy
    [A1].PasteSpecial
    Cells(2, 8) = "Date"
    Cells(3, 8) = Format(jour, "mm/dd/yyyy")
Next jour
Application.ScreenUpdating = True
' ActiveWorkbook.Save
End Sub

Bonne journée.
Cliquez pour agrandir...
Ca marche impec ;) merci Vmax
 
Vote positif 0 Vote négatif
K

Kath

XLDnaute Nouveau
job75 à dit:
Bonjour Kath, vmax01,

Bon puisqu'on pousse à la consommation voyez le fichier (2) et cette macro :
Code: 
Sub CreationMois()
Dim mois$, w As Worksheet, F As Worksheet, vis, n
Do
    mois = InputBox("Numéro du mois et année du mois à créer :", "Création du mois", Format(Date, "m/yy"))
    If mois = "" Then Exit Sub
Loop While Not IsDate("1/" & mois)
mois = "1/" & mois
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---RAZ---
For Each w In Worksheets
    If w.Name Like "##" Then w.Delete
Next
'---création des feuilles---
Set F = Sheets("modele")
vis = F.Visible
F.Visible = xlSheetVisible 'si la feuille est masquée
Application.Goto F.[A1], True 'cadrage
For n = 1 To Day(DateSerial(Year(mois), Month(mois) + 1, 0))
    F.Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = Format(n, "00")
    Sheets(Sheets.Count).[D2:G2].Clear 'adapter au besoin
    Sheets(Sheets.Count).[H3] = DateSerial(Year(mois), Month(mois), n)
Next
F.Visible = vis 'état initial
Sheets("Accueil").Activate
End Sub
La feuille modele est masquée et j'ai ajouté la feuille Accueil.

J'ai laissé les autres macros mais la création des boutons "MAJ" paraît assez peu utile...

A+
Cliquez pour agrandir...
Merci beaucoup pour ce fichier, tu es vraiment un as là dedans. :)
Bonne journée
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
142
marie3107
M
G
  • Question
XL 2019 formule TEXTE() + nom d'onglet
Réponses
2
Affichages
160
job75
job75
D
  • Résolu(e)
Microsoft 365 Modification de la mise en forme lors d'une copie
Réponses
9
Affichages
503
TooFatBoy
TooFatBoy
M
  • Question
Microsoft 365 VBA copier des données d'un classeur à un autre
Réponses
4
Affichages
176
sylvanu
sylvanu
W
  • Question
XL 2019 Extraire du texte à partir d'un renvoi de ligne automatique
Réponses
8
Affichages
323
DJunqueira
D
J
  • Question
Microsoft 365 Envoi automatique de plusieurs mails via un bouton
Réponses
0
Affichages
148
JoeZ1
J
P
  • Résolu(e)
Autres Création automatique de feuilles/onglets
Réponses
7
Affichages
258
pamela85200
P
D
  • Résolu(e)
Autres Création classeurs de 3 feuilles avec une information à reporter.
Réponses
7
Affichages
289
dhyeres
D
A
  • Résolu(e)
Microsoft 365 Désactiver temporairement l'impossibilité de renommer une feuille
Réponses
7
Affichages
251
AD95
A
P
  • Question
XL 2021 Code VBA pour copier coller des données de cellules d'une feuille a une autre
Réponses
4
Affichages
254
phoceenjo
P

Membres actuellement en ligne

26 membres et 169 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 194
Messages
2 086 068
Membres
103 110
dernier inscrit
Privé