victorrgds

Bom dia Pessoal, Possuo uma planilha que lê a data e envia um email quando essa data é = hoje. O que eu gostaria de fazer é o seguinte, no momento de criar o email, que esse código pegasse a linha seguinte a linha da data, numa coluna que eu determinar. o código é o seguinte: Private Sub Workbook_Open() Const tempo As Integer = 3 'a caixa de mensagem será exibida durante 3 seg Dim rsp As Integer Dim QuestionToMessageBox As String Dim OutApp As Object Dim OutMail As Object Dim texto As String Dim titulo As String Dim frsData As String, rngData As Range, c As Long Dim linha As Long, msg As Long Dim lRow As Long Set OutApp = CreateObject("Outlook.Application") With Sheets("Estimadores") 'Obtém última linha e soma 1: lRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1 c = 3 Do Set rngData = Sheets("Estimadores").Columns(c).Find(Date, LookIn:=xlValues) If Not rngData Is Nothing Then frsData = rngData.Address linha = rngData.Row Do If rngData.Interior.ColorIndex <> 50 Then texto = "Prezado(a) " & Sheets("Estimadores").Cells(linha, 2) & "," & vbCrLf & vbCrLf & _ "Suas duas semanas de penitência acabaram, " & Sheets("Estimadores").Cells(.Rows.Count, "B").End(xlUp).Row + 1 & _ " é o próximo(a) a ir pro curral" & vbCrLf & vbCrLf & _ "Controle de estimativas" titulo = "Controle Estimadores" Set OutMail = OutApp.CreateItem(0) With OutMail .To = Sheets("Estimadores").Cells(linha, 1).Value .CC = "" .BCC = "" .Subject = titulo .Body = texto .Send 'Utilize Send para enviar o email sem abrir o Outlook End With msg = msg + 1 rngData.Interior.ColorIndex = 50 End If Set rngData = Sheets("Estimadores").Columns(c).FindNext(rngData) linha = rngData.Row Loop While Not rngData Is Nothing And rngData.Address <> frsData End If c = c + 2 Loop While c < 3 rsp = CreateObject("WScript.Shell").PopUp( _ "enviadas " & msg & " mensagens" & vbLf & vbLf & _ "Deseja inserir dados no Controle de mapas?", tempo, _ "R E S P O N D A", 4 + 32) If rsp = 6 Then 'se a resposta for "Sim" MsgBox "Planilha Liberada" Else: ' se a resposta for "Não" ou se não houver resposta ActiveWorkbook.Save ThisWorkbook.Close Application.Quit End If End With End Sub Poderiam me ajudar? Caso não tenha sido muito claro, me informem... Consegui...rs Só coloquei a seguinte linha: "Suas duas semanas de penitência acabaram, " & Sheets("Estimadores").Cells(linha + 1, 2) & _ Obrigado galera!