Boa tarde, ARTOTTO
Estou com uma correria aqui, mas pude ver o seu caso e inclui alguns trechos
no seu código (para salientar, aqui funcionou com MsgBox 
)...
Porém como não utilizo o Outlook, não testei com o envio de e-mail, mas
funcionará é só seguir conforme abaixo :
Primeiro retire/exclua este trecho abaixo, do seu código:
linha = ActiveCell.Row - 1
If Target.Address = "$F$" & linha Then
If Plan1.Cells(linha, 1) = "HOJE()" Then
texto = "Prezado(a) " & Plan1.Cells(linha, 1) & "," & vbCrLf & _
"Consta a atividade" & Plan1.Cells(linha, 3) & " em aberto para você " & _
Plan1.Cells(linha, 5) & " Por gentileza verificar o cronograma." & _
vbCrLf & _
"Atenciosamente." & vbCrLf & vbCrLf & _
"XXXXXX" & vbCrLf & "Departamento XXXXX"
End If
With OutMail
.To = Plan1.Cells(linha, 1)
.CC = ""
.BCC = ""
.Subject = "Atividade - Cronograma Fechamento RH"
'.HTMLBody = texto
.Body = texto
.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
Agora no lugar deste acima, inclua este trecho abaixo no seu código:
Dim DataHoje As Date
Set Rng = Range("B4")
DataHoje = Date
Do While Rng.Value <> ""
Rng.Select
If Str(Rng.Value) = DataHoje Then
texto = "Prezado(a) " & Rng.Offset(0, -1).Value & "," & vbCrLf & _
"Consta a atividade " & Rng.Offset(0, 1).Value & " em aberto para você " & _
Rng.Offset(0, 3).Value & " Por gentileza verificar o cronograma." & _
vbCrLf & _
"Atenciosamente." & vbCrLf & vbCrLf & _
"XXXXXX" & vbCrLf & "Departamento XXXXX"
End If
Set Rng = Rng.Offset(1, 0)
Loop
' MsgBox (texto) ' linha de teste
With OutMail
.To = Plan1.Cells(linha, 1)
.CC = ""
.BCC = ""
.Subject = "Atividade - Cronograma Fechamento RH"
'.HTMLBody = texto
.Body = texto
.Display 'Utilize Send para enviar o email sem abrir o Outlook
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Set Rng = Nothing
Editado às 17:05hs (14/10/2019):
Desculpe na pressa errei a "posição" do trecho do envio do e-mail (se ficar como antes só será enviado o
último registro com a data atual, mesmo se tiver mais de um); então o correto seria como abaixo:
......
texto = "Prezado(a) " & Rng.Offset(0, -1).Value & "," & vbCrLf & _
"Consta a atividade " & Rng.Offset(0, 1).Value & " em aberto para você " & _
Rng.Offset(0, 3).Value & " Por gentileza verificar o cronograma." & _
vbCrLf & _
"Atenciosamente." & vbCrLf & vbCrLf & _
"XXXXXX" & vbCrLf & "Departamento XXXXX"
'colocar este trecho aqui
With OutMail
.To = Plan1.Cells(linha, 1)
.CC = ""
.BCC = ""
.Subject = "Atividade - Cronograma Fechamento RH"
'.HTMLBody = texto
.Body = texto
.Display 'Utilize Send para enviar o email sem abrir o Outlook
End With
End If
Set Rng = Rng.Offset(1, 0)
Loop
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Set Rng = Nothing
.....
Obs: a pesquisa é feita na coluna "B", pela data atual 
Por gentileza verificar se era isso que queria
Qualquer dúvida estamos aqui para ajudá-lo...
Aguardando sua resposta e seu Feed Back(é muito importante) ... se foi útil, não esqueça de clicar na "mãozinha" 
LaerteB
Postado : 14/10/2019 1:03 pm