VBA- Envoi mail automatique avec affichage des valeurs de cellules

Bonjour tout le monde, j'aurais besoin de votre aide pour finir mon programme VBA.

L'objectif de mon programme est d'envoyer un mail automatiquement au service achat lorsque nous n'avons plus assez de pièce en stock. Voici le programme en question:

Dim motif As String
Dim couleur As String
Dim xRg As Range
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("L4:L100"), Target)
If xRg Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value < 2 Then
motif = Intersect(Range("B4:B100"), Target)
couleur = Intersect(Range("I4:I100"), Target)
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Bonjour, il faut recommander une pièce" & vbNewLine & vbNewLine & _
"Motif " & motif & vbNewLine & _
"Couleur " & couleur & vbNewLine & vbNewLine & _
"Merci"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "Besoin de commander une pièce (mail automatique)"
.Body = xMailBody
.Display
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

"xRge" représente la quantité en stock, "motif" le motif de la pièce, et "couleur" la couleur de la pièce.

Je voudrais que le programme fonctionne de la façon suivante:

Si Lx<2

Alors envoyer mail: "Bonjour il faut recommander une pièce motif Bx couleur Ix" avec x allant de 4 à 100

J'arrive bien à envoyer le mail lorsque Lx est inférieur à 2 mais pas à joindre au mail les valeurs des cellules B et I correspondantes.

Je pense que mon problème vient des variables "motif" et "couleur" car lorsque je remplace ces variables par xrge dans ma sub mail cela fonctionne.

Merci d'avance pour votre aide

Personne n'a une idée ?

Bonjour,

Si j'ai bien compris ta demande ...

Je n'ai modifié que deux lignes ' << modif

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Intersect(Range("L4:L100"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value < 2 Then
        motif = Range("B" & Target.Row)    ' << modif
        couleur = Range("I" & Target.Row)    ' << Modif
        Call Mail_small_Text_Outlook
    End If
End Sub

ric

C'est exactement ce que je voulais faire, merci beaucoup ric !

ric