problème message box

[alexbud]

Bonjours a tous. J'ai créé une macro pour archiver des lignes qui s'incrément en ligne 54 , mais je n'arrive pas a faire une condition pour interdir un nouvel archivage avec un msg box "vous avez déjà archivé aujourd'hui", si la date est celle d'aujourd'hui.
Merci pour votre aide

 

[Dudu2]

If ActiveSheet.Range("C54") = Date Then
    MsgBox "Vous avez déjà archivé aujourd'hui"
    Exit Sub
End If

 

[alexbud]

Merci Dudu2. mais je ne comprend pas comment utiliser ton code. J'ai soit le message même si la date n'est pas celle d'aujourd'hui, soit le message avec la date d'aujourd'hui, mais la ligne s'incrément quand même.
voici mon code
Sub archive()

DateAuj = Sheets("PROGRESS REPORT DASHBOARD").Range("C54").Value

Rows("54:54").Select

Selection.Insert Shift:=x1Down, CopyOrigin:=x1FormatFromAbove

Sheets("PROGRESS REPORT DASHBOARD").Range("C54").Value = Sheets("PROGRESS REPORT DASHBOARD").Range("I2").Value

Sheets("PROGRESS REPORT DASHBOARD").Range("D54").Value = Sheets("PROGRESS REPORT DASHBOARD").Range("G12").Value

Sheets("PROGRESS REPORT DASHBOARD").Range("E54").Value = Sheets("PROGRESS REPORT DASHBOARD").Range("G24").Value

Sheets("PROGRESS REPORT DASHBOARD").Range("F54").Value = Sheets("PROGRESS REPORT DASHBOARD").Range("G32").Value

Sheets("PROGRESS REPORT DASHBOARD").Range("G54").Value = Sheets("PROGRESS REPORT DASHBOARD").Range("G47").Value

End Sub

 

[Dudu2]

Option Explicit

Sub Archive()
    With Sheets("PROGRESS REPORT DASHBOARD")
        If .Range("C54") = Date Then
            MsgBox "Vous avez déjà archivé aujourd'hui !"
            Exit Sub
        End If
  
        .Rows(54).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("C54").Value = Date
        .Range("D54").Value = .Range("G12").Value
        .Range("E54").Value = .Range("G24").Value
        .Range("F54").Value = .Range("G32").Value
        .Range("G54").Value = .Range("G47").Value
    End With
End Sub

Le AUJOUDHUI() en I2 ne sert à rien, tu peux le supprimer.

 

[Dudu2]

A ta place je ferais plutôt ça...
D'une part ne pas interdire l'archivage multiple sur la date du jour au cas où il y aurait une correction.
D'autre part informer de l'action du bouton quand elle est terminée.

Option Explicit

Sub Archive()
    With Sheets("PROGRESS REPORT DASHBOARD")
        'Si la date en C54 n'est pas la date du jour, on insert une ligne
        If .Range("C54") <> Date Then
            .Rows(54).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    
        'Recopie des valeurs
        .Range("C54").Value = Date
        .Range("D54").Value = .Range("G12").Value
        .Range("E54").Value = .Range("G24").Value
        .Range("F54").Value = .Range("G32").Value
        .Range("G54").Value = .Range("G47").Value
    End With
    
    MsgBox "Archivage terminée !"
End Sub

 

[alexbud]

Dudu2
Super merci pour ton intervention
🙂