Copy Cells into email body when cell change

CLC-QC said:

i am having trouble figuring out how to make this work.

what i want is when any cells in the (H) colmun change to copy the cell content and paste them into outlook in the email body

for example

Cell (H5) changes copy Cells (C5:F5)

Cell H6 changes copy cells (C6:F6)

and so forth...

i can get the first part of the code to work where it senses the cell changes

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim xRgSel As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xRg = Range("H5:H99999")
    Set xRgSel = Intersect(Target, xRg)
    ActiveWorkbook.Save
    If Not xRgSel Is Nothing Then
        Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = _
             "' Requested on " & _
            Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
            " by " & Environ$("username") & "."
 
        With xMailItem
            .To = "crobertson@climatecraft.com"
            .Subject = "Loose Parts Request"
            .Body = xMailBody
            
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Click to expand...