Archiver Valeurs Journalières pour création tableau

Bonjour,

bonne année et bonne santé à tous !

j'ai presque trouvé ma réponse avec ce problème résolu :

https://forum.excel-pratique.com/excel/archivage-ligne-condition-dates-t20172.html

mais dans mon cas je voulais juste mettre un bouton d'action sur lequel je clique pour que mon archive se fasse avec la date du jour.

En gros:

J'ai les cellules F34 H34 J34 F35 H35 J35

que j'aimerais envoyer sur une feuille "ARCHIVAGE" quotidiennement pour faire un tableau de stats.

D2 est la cellule dans laquelle j'ai la date du Jour

Pour cela j'aimerais juste cliquer sur un bouton d'action pour archiver mes données.

Petit supplément si possible : si je clique sur mon bouton d'action 10 fois dans la journée la ligne doit se superposer dans la feuille archivage et non me mettre une ligne supp, par contre si la date est différente dans ce cas une ligne supp doit se rajoute

j'espère avoir été assez clair

Merci pour votre aide

Bonjour,

Peux-tu envoyer les feuilles concernées ?

Claude

merci pour ton aide

les cellules : F34 H34 J34 F35 H35 J35

sont modifiées par S1 - S2 - U1 - U2 - W1 - W2

re,

Ok, je regarde dans la soirée

Claude

Bonjour,

Un début de réponse :

Sub Sauv()
Dim LaDate As Range, C As Range
Dim DerLig As Long
Dim Plage, Plg
Dim I As Byte
With Sheets("Compte rendu de réunion1")
    Set LaDate = .Range("D2")
    Plage = Array(.Range("S1"), .Range("S2"), .Range("W1"), .Range("U1"), .Range("W2"), .Range("U2"))
End With
With Sheets("ARCHIVE")
    .Columns(1).NumberFormat = "m/d/yyyy"
    .Columns("B:C").Style = "Percent"
    Set C = .Columns(1).Find(LaDate)
    If Not C Is Nothing Then
        DerLig = C.Row
    Else
        DerLig = .Range("B65000").End(xlUp)(2).Row
        .Cells(DerLig, 1) = LaDate
    End If
    I = 2
    For Each Plg In Plage
        .Cells(DerLig, I).Value = Plg
        I = I + 1
    Next Plg
End With
End Sub

Bonne journée

Bonsoir à tous,

Sub Archive()
'Macro par Claude Dubois pour "jobiniou" Excel-Pratique le 06/01/11
Dim Lg%
    Sheets("Compte rendu de réunion1").Activate
    With Sheets("ARCHIVE")
        If .Range("a65536").End(xlUp) = Date Then
            Lg = .Range("a65536").End(xlUp).Row
        Else
            Lg = .Range("a65536").End(xlUp).Row + 1
            .Rows(2).Copy
            .Rows(Lg).PasteSpecial Paste:=xlPasteFormats
            Application.CutCopyMode = False
        End If
        .Cells(Lg, "a") = Range("d2")
        .Cells(Lg, "b") = Range("s1")
        .Cells(Lg, "c") = Range("s2")
        .Cells(Lg, "d") = Range("w1")
        .Cells(Lg, "e") = Range("w2")
        .Cells(Lg, "f") = Range("u1")
        .Cells(Lg, "g") = Range("u2")
        .Activate
        .Cells(Lg, "a").Select
    End With
End Sub

Amicalement

Claude

Super !!!

Merci ca marche nickel

Bon WE à vous