Bonjour à tous,

Je vous explique ma situation, j'ai crée un tableau excel avec une macro.
Ce tableau doit respecter deux conditions : Si une donnée est entrée dans une cellule de la colonne 9, la ligne doit être déplacée dans la feuille "Envoyés"
Et si une donnée est entrée dans une cellule de la colonne 8, un mail doit être envoyé sur une boite (toujours la même) pour informer que le doc est dispo.

Mon code fonctionne mais seulement la première fois que je vais saisir une donnée dans la colonne concernée.
Si je souhaite renseigner le champ de plusieurs dossier le mail ne s'enverra que pour le premier.


Si quelqu'un a une idée pour m'aider ce serait super,

Bonne journée à tous, merci
(je vous joins mon code)

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Private Sub Worksheet_Change(ByVal Target As Range)
  If (Target.Column = 9) And (ActiveSheet.Cells(Target.Row, Target.Column).Value <> "") Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        laligne = Target.Row
        info = MsgBox("Transférer cette ligne sur la feuille 'Envoyés' ?", vbYesNo + vbInformation, "Tableau de suivi des SFR")
        If (info = vbYes) Then
            Rows(laligne & ":" & laligne).Copy
            Sheets("Envoyés").Select
            ligne = 2
            While ThisWorkbook.Sheets("Envoyés").Range("A" & ligne).Value <> ""
                ligne = ligne + 1
            Wend
 
 
            ThisWorkbook.Sheets("Envoyés").Rows(ligne & ":" & ligne).Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
 
 
            Sheets("A envoyer").Select
            Rows(laligne & ":" & laligne).Delete Shift:=xlUp
            Application.CutCopyMode = False
        End If
        Application.EnableEvents = True
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
 
 
 
    ElseIf (Target.Column = 8) And (ActiveSheet.Cells(Target.Row, Target.Column).Value <> "") Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        laligne = Target.Row
        info = MsgBox("Prévenir ADV ?", vbYesNo + vbInformation, "Tableau de suivi des SFR")
        If (info = vbYes) Then
 
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
 
 
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
 
 
        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Bonjour,<br><br>" & _
                  "La documentation<B> " & Cells(ActiveCell.Row, 1).Value & " </B>est disponible." & _
                  "<br><br>Cordialement</font>"
 
 
        With OutMail
            .To = "***@***.com"
            .CC = ""
            .BCC = ""
            .Subject = "SFR Disponible"
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
 
        End If
    End If
End Sub