Macro VBA, Interdire d’enregistrer si doublon

Question

S’il vous plait, je sollicite votre aide. En fait, je viens de mettre en place un ouil_Excel avec 3 Macros, la première c’est pour créer de nouveau numéro, la deuxième macro c’est pour archiver les nouveaux ID avec leurs infos qui sont inscrites dans les cellules : C2, C3, C4, C5, E2, E3 et E4 de la feuille SOURCE. La troisième macro c’est pour faire une recherche des numéros ID. Toutes les macros fonctionnent très bien. Le problème c’est que, quand je fais recherche d’un numéro ID existant dans la feuille ARCHVAGE avec la macro-RECHERCHE Numéro ID, la macro m’affiche le numéro recherché avec les infos dans les cellules C2, C3, C4, C5, E2, E3 et E4. Cependant quand je clique par erreur sur la macro Archiver, cette dernière enregistre encore le même numéro ID avec les mêmes infos dans la feuille ARCHVAGE (Information en double). S’il vous plait, serait-il possible de m’aider de sorte que quand je clique par erreur sur la macro archiver d’un Numéro ID déjà existant, le système m’affichera un message qui m’indiquera que le numéro existe déjà dans la feuille ARCHIVAGE ainsi m’interdire d’enregistrer. Cordialement...

Invité · Accepted Answer

Voici le code pour remplacer celui du module2 Option Explicit ' Permet le déboggage en vas d'erreur Sub ARCHIVER() Dim CelF As Range, ShtA As Worksheet, ShtS As Worksheet Dim Ligne As Long ' Définir la plage de recherche Set ShtA = ThisWorkbook.Sheets("ARCHIVAGE") Set ShtS = ThisWorkbook.Sheets("SOURCE") ' Cherche si l'ID existe Set CelF = ShtA.Range("A:A").Find(What:=Range("E2").Value, LookIn:=xlValues, LookAt:=xlWhole, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False) ' Si une cellule à été trouvée If Not CelF Is Nothing Then MsgBox "Ce numéro ID existe déjà," & vbCr _ & "vous ne pouvez pas archiver la fiche !", vbExclamation, "OUPS..." GoTo FinSub End If ' Sinon on enregistre les infos If Sheets("SOURCE").Range("C2").Value = "" Then MsgBox (" Vous ne pouvez pas enregistrer une feuille vide") If Sheets("SOURCE").Range("C2").Value = "" Then Exit Sub If MsgBox(" Etes-vous certain de vouloir archiver la feuille ?", vbOKCancel, "Demande de confirmation") = vbCancel Then Exit Sub ' Si tout ok Ligne = ShtA.Range("A2").End(xlDown).Row + 1 ShtA.Range("A" & Ligne).Value = ShtS.Range("E2").Value ShtA.Range("B" & Ligne).Value = ShtS.Range("C5").Value ShtA.Range("C" & Ligne).Value = ShtS.Range("C3").Value ShtA.Range("D" & Ligne).Value = ShtS.Range("C4").Value ShtA.Range("E" & Ligne).Value = ShtS.Range("E3").Value ShtA.Range("F" & Ligne).Value = ShtS.Range("E4").Value ShtA.Range("k" & Ligne).Value = ShtS.Range("C2").Value ShtS.Range("E2").Value = ShtS.Range("E2").Value + 1 ShtS.Range("C2, C3, C4, C5,E3,E4,E7,C34, C35, C36, E34, E35, E36,E2").ClearContents FinSub: ' Effacer les variable objet Set CelF = Nothing: Set ShtS = Nothing: Set ShtA = Nothing End Sub @+...