Felipe Carvalho_748684

Boa atrde pessoal,
 
Resolvido. Obrigado Mikel Silveira Fraga - TVForum
 
Private Sub Worksheet_Change(ByVal Target As Range)

    'Essas coordenadas correspondem a Range "B4:D1000".
    If (Target.Row >= 4 And Target.Row <= 1000) And _
        (Target.Column >= 2 And Target.Column <= 4) Then
   
        Dim intLinha As Long
       
        intLinha = Target.Row
   
        Range("A" & intLinha).Value = Application.InputBox("Número de contato: " & _
                                                Plan1.Range("H" & intLinha).Value & " ")
   
    End If

End Sub

Bom dia pessoal,
 
Me virei na aba DADOS e consegui usando a importação de dados simples.

Consegui, o código ficou bem grande, mas está funcionando:
 
Private Sub Worksheet_Change(ByVal Target As Range)

 If Target.Column = 2 Then Cells(Target.Row, 5) = Date
 If Target.Column = 3 Then Cells(Target.Row, 6) = Date
 If Target.Column = 4 Then Cells(Target.Row, 7) = Date
 
    Dim OutApp As Object
    Dim OutMail As Object
    Dim texto As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    linha = ActiveCell.Row - 1
    If Target.Address = "$B$" & linha Then
    If Plan1.Cells(linha, 2) = "X" Then
            
        End If

        With OutMail
            .To = Plan1.Cells(linha, 1)
            .CC = ""
            .BCC = ""
            .Subject = "Título do email"
            .Body = "Prezado(a) " & Plan1.Cells(linha, 1) & "," & vbCrLf & vbCrLf & _
                    "A O.S. " & Plan1.Cells(linha, 7) & " aberta em " & _
                    Plan1.Cells(linha, 2) & " foi concluída." & vbCrLf & _
                    " Veja informações abaixo:" & vbCrLf & _
                    "    Status: " & Plan1.Cells(linha, 6) & vbCrLf & _
                    "    Ação tomada: " & Plan1.Cells(linha, 5) & vbCrLf & vbCrLf & _
                    "Atenciosamente," & vbCrLf & _
                    "Help Desk"
            .Display   'Utilize Send para enviar o email sem abrir o Outlook
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    End If
    
    linha = ActiveCell.Row - 1
    If Target.Address = "$C$" & linha Then
    If Plan1.Cells(linha, 2) = "X" Then
            
        End If

        With OutMail
            .To = Plan1.Cells(linha, 1)
            .CC = ""
            .BCC = ""
            .Subject = "Título do email"
            .Body = "Prezado(a) " & Plan1.Cells(linha, 1) & "," & vbCrLf & vbCrLf & _
                    "A O.S. " & Plan1.Cells(linha, 7) & " aberta em " & _
                    Plan1.Cells(linha, 2) & " foi concluída." & vbCrLf & _
                    " Veja informações abaixo:" & vbCrLf & _
                    "    Status: " & Plan1.Cells(linha, 6) & vbCrLf & _
                    "    Ação tomada: " & Plan1.Cells(linha, 5) & vbCrLf & vbCrLf & _
                    "Atenciosamente," & vbCrLf & _
                    "Help Desk"
            .Display   'Utilize Send para enviar o email sem abrir o Outlook
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    End If
    
      linha = ActiveCell.Row - 1
    If Target.Address = "$D$" & linha Then
    If Plan1.Cells(linha, 2) = "X" Then
            
        End If

        With OutMail
            .To = Plan1.Cells(linha, 1)
            .CC = ""
            .BCC = ""
            .Subject = "Título do email"
            .Body = "Prezado(a) " & Plan1.Cells(linha, 1) & "," & vbCrLf & vbCrLf & _
                    "A O.S. " & Plan1.Cells(linha, 7) & " aberta em " & _
                    Plan1.Cells(linha, 2) & " foi concluída." & vbCrLf & _
                    " Veja informações abaixo:" & vbCrLf & _
                    "    Status: " & Plan1.Cells(linha, 6) & vbCrLf & _
                    "    Ação tomada: " & Plan1.Cells(linha, 5) & vbCrLf & vbCrLf & _
                    "Atenciosamente," & vbCrLf & _
                    "Help Desk"
            .Display   'Utilize Send para enviar o email sem abrir o Outlook
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    End If
End Sub