XL 2013 Création bouton de copie

[Kath]

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

 

[job75]

Bonjour Kath, bienvenue sur XLD,

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

A+

 

[Kath]

La feuille précédente donc la 30.11.18 ici

 

[vmax01]

bonjour Kath et le forum.

voila un petit programme a adapter mais cela fonctionne.

Sub Coierfuille()
Dim newsheet As Worksheet
ActiveSheet.Cells.Copy
Set newsheet = Sheets.Add
    With newsheet
        .Name = "essai"
        .Paste
        .Range("H2:H3").ClearContents
    End With
End Sub

bonne journée

 

[vmax01]

voila ton fichier Kath

 

[Kath]

voila ton fichier Kath

J'ai essayé de l'adapter mais en vain, comment ajouter ce code à mon module 2?

 

[vmax01]

quel problème rencontres tu ?

 

[Kath]

La nouvelle feuille se place avant le 30/11/18 sur le classeur.
Rien de bien méchant.
mais j'aimerai aussi insérer le sub copierfeuille dans une macro existante (le module 2 plus exactement), c'est à dire que quand je lancerai cette macro j'aimerai que le tableau apparaisse sur chacuns des onglets (ceux numérotés de 01 à 30).Mais je n'y parviens pas :/

 

[vmax01]

tu n'est pas obligé de recopier la sub dans ton module2 tu peux juste faire appel à elle .... dans ton module2 tu peux introduire la ligne suivante

call copierfeuille

et ça ira directement sur cette sub....

 

[Kath]

tu n'est pas obligé de recopier la sub dans ton module2 tu peux juste faire appel à elle .... dans ton module2 tu peux introduire la ligne suivante

call copierfeuille

et ça ira directement sur cette sub....

J'ai bien essayé mais je n'y arrive pas :'(
Je te mets ma macro ci dessous j'espère que tu pourras éclairer ma lanterne

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")
    Cells(2, 8) = "Date"
  
    Cells(3, 8) = Format(Jour, "mm/dd/yyyy")
Next Jour
Dim arrWSN() As String
'crée un tableau avec le nom de toutes les feuilles du classeur actif
ReDim arrWSN(1 To ActiveWorkbook.Sheets.Count)
For i = 1 To Sheets.Count
arrWSN(i) = Sheets(i).Name
Next i
'permet de recopier une plage de cellules définies issue
'd'une d'une feuille "MODELE"
'sur tous les feuilles d'un même classeur
   ' ActiveWorkbook.Save
End Sub

 

[vmax01]

je ne comprend pas ce que tu veux faire avec la fin de ton code

Dim arrWSN() As String
'crée un tableau avec le nom de toutes les feuilles du classeur actif
ReDim arrWSN(1 To ActiveWorkbook.Sheets.Count)
For i = 1 To Sheets.Count
arrWSN(i) = Sheets(i).Name
Next i
'permet de recopier une plage de cellules définies issue
'd'une d'une feuille "MODELE"
'sur tous les feuilles d'un même classeur

donne un exemple plus concret

 

[Kath]

je ne comprend pas ce que tu veux faire avec la fin de ton code

Dim arrWSN() As String
'crée un tableau avec le nom de toutes les feuilles du classeur actif
ReDim arrWSN(1 To ActiveWorkbook.Sheets.Count)
For i = 1 To Sheets.Count
arrWSN(i) = Sheets(i).Name
Next i
'permet de recopier une plage de cellules définies issue
'd'une d'une feuille "MODELE"
'sur tous les feuilles d'un même classeur

donne un exemple plus concret

à vrai dire je n'y connais rien, je me contente de copier les macros que je trouve sur le net et celles que vous me créez.

J'ai fait dans mon classeur une feuille modèle, j'aimerai que le tableau qui apparaît sur cette dernière, soit copié sur tous les autres onglets lorsque je lancerai ma macro.

 

[job75]

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 :

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

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+

 

[vmax01]

ok si j'ai bien compris voila ton classeur final

avec le code pour ceux que ça intéresse.

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
    Cells(2, 8) = "Date"
    Cells(3, 8) = Format(jour, "mm/dd/yyyy")
Next jour
Application.ScreenUpdating = True
' ActiveWorkbook.Save
End Sub

bonne journée

 

[vmax01]

desolé Job75 et bonjour nos messages se sont croisés....