Condition MsgBox annulation Copy/Paste

Bonjour à tous,

J'ai un problème sur un de mes codes VBA, je ne suis pas un grand professionnel mais je fais des actions basiques.

J'ai un fichier avec 2 feuilles :

Feuilles 1 "JOURNALIER" où on doit remplir une colonne ("B7:B31") avec les sorties du jour, on choisit le jour dans la liste en "A4" et on valide avec un bouton "VALIDER", l'action de ce bouton va copier dans la feuille 2 "MENSUEL" , les données de ("B7:B31") pour les coller en ("B11:B35")

Feuille 2 "Mensuel" regroupe tous les jours sur plusieurs colonnes (1,2,3,4, etc jusque 31) et calcule le total des sorties.

tout fonctionne parfaitement, j'ai un message qui demande de confirmer que les données sont bonnes ainsi que la date.

Mon problème c'est que si malgré le message d'erreur la date est fausse, le copier coller va écraser les données déjà existantes sur cette date. J'aimerais avoir une boîte de dialogue qui s'ouvre si la colonne correspondant à cette date est non vide avec pour action de cliquer sur OK l'annulation du copier. J'ai beau chercher et essayer plusieurs méthode rien y fait, soit j'ai bien la boîte de dialogue mais ça ne copie plus même quand c'est vide soit j'ai le message même quand c'est vide ce qui fait douter la personne qui écrit.

Bref, j'ai besoin de vos lumières s'il vous plaît.

Voici mon code :

Sub VALIDER()

If MsgBox("Avez-vous bien vérifier vos données et le jour de délivrance ?", vbYesNo + vbExclamation, "Confirmation") = vbNo Then Exit Sub

Sheets("JOURNALIER").Activate
Set Range1 = Range("B7:B31")

    If Range("A4").Value Like "1" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("B11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    If Range("A4").Value Like "2" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("C11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "3" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("D11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "4" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("E11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "5" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("F11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "6" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("G11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "7" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("H11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "8" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("I11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "9" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("J11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "10" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("K11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "11" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("L11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "12" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("M11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "13" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("N11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "14" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("O11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "15" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("P11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "16" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("Q11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "17" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("R11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "18" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("S11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "19" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("T11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "20" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("U11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "21" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("V11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "22" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("W11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "23" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("X11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "24" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("Y11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "25" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("Z11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "26" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("AA11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "27" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("AB11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "28" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("AC11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "29" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("AD11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "30" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("AE11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ElseIf Range("A4").Value Like "31" Then
    Range1.Copy
    Sheets("MENSUEL").Activate
    Range("AF11").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues

End If

Sheets("JOURNALIER").Range("B7:B31").ClearContents
Sheets("JOURNALIER").Activate

End Sub

Merci beaucoup pour votre aide et si je n'ai pas été clair, n'hésitez pas à revenir vers moi.

Bonne journée,

Bonjour Max191, le forum,

Un essai à tout hasard....pas pu tester car pas de fichier...

Sub VALIDER()
 Dim range1 As Range

 If MsgBox("Avez-vous bien vérifier vos données et le jour de délivrance ?", vbYesNo + vbExclamation, "Confirmation") = vbNo Then Exit Sub
  With Sheets("JOURNALIER")
   If Not IsDate(.Range("A4")) Then MsgBox "La date est incorrecte! ": Exit Sub
    Set range1 = .Range("B7:B31")
     range1.Copy Sheets("MENSUEL").Cells(11,.Range("A4").Value + 1)
     range1.ClearContents
     .Activate
  End With
End Sub

Cordialement,

Bonjour,

Merci beaucoup pour la réponse.

Malheureusement, je ne peux pas car je n'ai pas mis le format Date car ça faisait buggait mon autre macro.

voici mon fichier et mes macros, je ne peux pas les envoyer par email en version xlsm et module.bas

donc j'envoie séparément et en version .xlsx et .txt

Merci beaucoup de ton aide,

bonne journée,

Salut

A tester, si j'ai bien compris la demande.
J'ai supprimer tous les Activates qui ne font qu'alourdir le code

Sub VALIDER()
Dim Range1 As Range
Dim RangeToCopy As Range
Dim rCount As Long
Dim wS As Worksheet

    If MsgBox("Avez-vous bien vérifier vos données et le jour de délivrance ?", vbYesNo + vbExclamation, "Confirmation") = vbNo Then Exit Sub

    Sheets("JOURNALIER").Activate
    Set wS = Worksheets("MENSUEL")
    Set Range1 = Sheets("JOURNALIER").Range("B7:B31")

    Application.EnableEvents = False
    With wS
        rCount = .Range("A1").Value
        Set RangeToCopy = .Range(.Cells(11, rCount + 1), .Cells(11, rCount + 1)).Resize(Range1.Rows.Count)

        ' // Je ne teste que la première cellule de la plage si l'on douit tester toutes les cellule faudra faire une boucle
        If RangeToCopy.Range("A1").Value <> "" Then

            Select Case MsgBox("La plage pour le jour " & rCount & " comporte déjà des données." & vbNewLine & _
                               "Voulez-vous ecraser les données existantes ?", vbExclamation Or vbYesNo Or vbDefaultButton2, "Informations")
                Case vbYes
                    .Range(.Cells(11, rCount + 1), .Cells(11, rCount + 1)).Resize(Range1.Rows.Count).Value = Range1.Value

                Case vbNo
                    MsgBox "Les données n'ont pas été enregistrées "
            End Select
        Else
            .Range(.Cells(11, rCount + 1), .Cells(11, rCount + 1)).Resize(Range1.Rows.Count).Value = Range1.Value

        End If
    End With

    Application.EnableEvents = True

End Sub

Re,

Un autre essai:

Sub VALIDER()
 Dim range1 As Range

 If MsgBox("Avez-vous bien vérifier vos données et le jour de délivrance ?", vbYesNo + vbExclamation, "Confirmation") = vbNo Then Exit Sub
  With Sheets("JOURNALIER")
   Set range1 = .Range("B7:B31")
    If Not IsNumeric(.Range("A4")) Or .Range("A4") = "" Then MsgBox "Selectionner un jour! ": Exit Sub
    If Application.CountA(range1) = 0 Then MsgBox "Aucunes données !": Exit Sub
     Sheets("MENSUEL").Cells(11, Range("A4").Value + 1).Resize(range1.Rows.Count) = range1.Value
     range1.ClearContents
     .Activate
  End With
End Sub

Mais comme l'a stipulé Jean-Paul, que faire si le jour contient déjà des données ?

• On annule ?
• On écrase ? (actuellement par défaut)
• On additionne ?

Cordialement,

Bonjour à vous,

merci de vous réponses et désolé du délai de réponses.

pour répondre à vos interrogations :

Lorsque les cellules de la feuille MENSUEL sont non vides alors on annule.

après essai des formules :

@xorsankukai : cela copie au bon endroit mais ne fait pas de messages d'erreur si les cellules sont déjà remplies et les écrase automatiquement.

@Jean-Paul : J'ai bien le message d'erreur mais cela prend en compte la colonne A donc comprends et efface les données des noms des produits et non les colonnes où doivent être les chiffres. J'ai essayé de modifier les formules mais ça 'e fonctionne pas non plus.

j'essaie de chercher mais que des erreurs grrr.

merci de votre aide,

bonne journée,

cordialement,

Bonjour à tous,

Bonne et heureuse année 2022, santé et bonheur !

@xorsankukai : cela copie au bon endroit mais ne fait pas de messages d'erreur si les cellules sont déjà remplies et les écrase automatiquement.

Oui, c'est bien ce que je t'avais signalé....

Mais comme l'a stipulé Jean-Paul, que faire si le jour contient déjà des données ?

On annule ?

On écrase ? (actuellement par défaut)

On additionne ?

Sub VALIDER()
 Dim range1 As Range, plage As Range
 Dim dl%, col%
 Dim shM As Worksheet, shJ As Worksheet
  Set shM = Sheets("MENSUEL"): dl = shM.Range("A" & Rows.Count).End(xlUp).Row
  Set shJ = Sheets("JOURNALIER")

 If MsgBox("Avez-vous bien vérifier vos données et le jour de délivrance ?", vbYesNo + vbExclamation, "Confirmation") = vbNo Then Exit Sub
  With shJ
   Set range1 = .Range("B7:B31")
          col = .Range("A4").Value + 1
    Set plage = shM.Range(shM.Cells(11, col), shM.Cells(dl, col))

     If Not IsNumeric(.Range("A4")) Or .Range("A4") = "" Then MsgBox "Selectionner un jour! ": Exit Sub
      If Application.CountA(range1) = 0 Then MsgBox "Aucunes données !": Exit Sub
       If Application.CountA(plage) > 0 Then MsgBox "Données déjà présentes !" & Chr(10) & "Enregistrement annulé": Exit Sub
        shM.Cells(11, col).Resize(range1.Rows.Count) = range1.Value
       range1.ClearContents
      MsgBox "Données enregistrées"
     .Activate
  End With
End Sub

Cordialement,

Une très belle et heureuse année à vous egalement !!

Merci pour le code. C'est parfait, il fonctionne à merveille. Je vais continuer à approfondir mes connaissances qui restent très basiques finalement.

bonne journée à vous,

Cordialement,