Empecher d'archiver si le numero de document existe dejas dans l'archive
Salut
je veux faire une modification sur ce macro ,su vous pouvez m'aider
lorsque je clique sur archiver si le numéro de la cellule H6 de la feuille BON DE RECEPTION dejas existe dans la colonne A de la feuille ARCHIVE BR ,il doit pas archiver il doit m'afficher un message d'information que le numéro existe dejas .
Sub Archiver()
Set fa = Sheets("ARCHIVE BR")
Set fbr = Sheets("BON DE RECEPTION")
lgn = fa.Range("H" & Rows.Count).End(xlUp)(2).Row
Application.ScreenUpdating = False
For i = 12 To fbr.Range("C52").End(xlUp).Row Step 2
fa.Range("A" & lgn + i / 2 - 6) = fbr.Range("H6")
fa.Range("B" & lgn + i / 2 - 6) = fbr.Range("I9")
fa.Range("C" & lgn + i / 2 - 6) = fbr.Range("N22")
fa.Range("D" & lgn + i / 2 - 6) = fbr.Range("P42")
fa.Range("E" & lgn + i / 2 - 6) = fbr.Range("M44")
fa.Range("F" & lgn + i / 2 - 6) = fbr.Range("L25")
fa.Range("G" & lgn + i / 2 - 6) = fbr.Range("L18")
fa.Range("H" & lgn + i / 2 - 6) = fbr.Range("J12")
fa.Range("O" & lgn + i / 2 - 6) = fbr.Range("L48")
fa.Range("D" & lgn + i / 2 - 6) = fbr.Range("M42")
fa.Range("I" & lgn + i / 2 - 6) = fbr.Range("A" & i) * 1
fa.Range("J" & lgn + i / 2 - 6) = fbr.Range("C" & i)
fa.Range("K" & lgn + i / 2 - 6) = fbr.Range("E" & i)
fa.Range("L" & lgn + i / 2 - 6) = fbr.Range("G" & i) * 1
fa.Range("M" & lgn + i / 2 - 6) = fbr.Range("H" & i)
fa.Range("N" & lgn + i / 2 - 6) = fbr.Range("G" & i) * fbr.Range("H" & i)
fbr.Range("A" & i) = ""
fbr.Range("C" & i) = ""
fbr.Range("E" & i) = ""
fbr.Range("G" & i) = ""
fbr.Range("H" & i) = ""
Next i
fbr.Range("j12:p12,L24:M24,P24,P25,J28:P28,J30:P30,M40:P40,M42:O42,M44:P44,L55:P55").ClearContents
For i = 1 To 6
adb = Choose(i, "I9", "N22", "P42", "L25", "L18", "L48")
fbr.Range(adb) = ""
Next i
fbr.Range("H6") = fbr.Range("H6") + 1
MsgBox "Les données ont été enregistrées."
End Sub
Bonjour,
Voici un essai à saisir avant la boucle :
If application.countif(fa.columns(1), fbr.range("H6").value) > 0 then
msgbox "existe dejà"
exit sub
end ifAu fait, pour rendre le code lisible, vous pouvez vous servir de l'icone </> sur le ruban de commentaire
Cdlt,
Un petit effort Akssel quand même
Sub Archiver()
Set fa = Sheets("ARCHIVE BR")
Set fbr = Sheets("BON DE RECEPTION")
lgn = fa.Range("H" & Rows.Count).End(xlUp)(2).Row
If application.countif(fa.columns(1), fbr.range("H6").value) > 0 then
msgbox "existe dejà"
exit sub
end if
Application.ScreenUpdating = False
For i = 12 To fbr.Range("C52").End(xlUp).Row Step 2
fa.Range("A" & lgn + i / 2 - 6) = fbr.Range("H6")
fa.Range("B" & lgn + i / 2 - 6) = fbr.Range("I9")
fa.Range("C" & lgn + i / 2 - 6) = fbr.Range("N22")
fa.Range("D" & lgn + i / 2 - 6) = fbr.Range("P42")
fa.Range("E" & lgn + i / 2 - 6) = fbr.Range("M44")
fa.Range("F" & lgn + i / 2 - 6) = fbr.Range("L25")
fa.Range("G" & lgn + i / 2 - 6) = fbr.Range("L18")
fa.Range("H" & lgn + i / 2 - 6) = fbr.Range("J12")
fa.Range("O" & lgn + i / 2 - 6) = fbr.Range("L48")
fa.Range("D" & lgn + i / 2 - 6) = fbr.Range("M42")
fa.Range("I" & lgn + i / 2 - 6) = fbr.Range("A" & i) * 1
fa.Range("J" & lgn + i / 2 - 6) = fbr.Range("C" & i)
fa.Range("K" & lgn + i / 2 - 6) = fbr.Range("E" & i)
fa.Range("L" & lgn + i / 2 - 6) = fbr.Range("G" & i) * 1
fa.Range("M" & lgn + i / 2 - 6) = fbr.Range("H" & i)
fa.Range("N" & lgn + i / 2 - 6) = fbr.Range("G" & i) * fbr.Range("H" & i)
fbr.Range("A" & i) = ""
fbr.Range("C" & i) = ""
fbr.Range("E" & i) = ""
fbr.Range("G" & i) = ""
fbr.Range("H" & i) = ""
Next i
fbr.Range("j12:p12,L24:M24,P24,P25,J28:P28,J30:P30,M40:P40,M42:O42,M44:P44,L55:P55").ClearContents
For i = 1 To 6
adb = Choose(i, "I9", "N22", "P42", "L25", "L18", "L48")
fbr.Range(adb) = ""
Next i
fbr.Range("H6") = fbr.Range("H6") + 1
MsgBox "Les données ont été enregistrées."
End SubCdlt,