Boa Tarde,

Não sei se esta é a melhor solução mas fiz um codigo para tentar fazer este bloqueio:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim wsRef As Worksheet, Rng As Range, ws As Worksheet
    Dim r As Range
    Dim contador As Long, ColunaUsuario As Long, ColunaData As Long, Senha As String
    contador = 1
    
    '''''''''''''''''''Parte Editavel'''''''''''''''''''''''''''''''''
    Set wsRef = Sheets("Plan 1")  'Nome da Planilha de historico
    ColunaUsuario = 5             'Coluna dos Usuarios no historico
    ColunaData = 1                'Coluna das Datas no historico
    Senha = "123456"              'Senha Da Planilha
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Ultimalinha = wsRef.Range("A" & Rows.Count).End(xlUp).Row
    For l = 1 To Ultimalinha
        If wsRef.Cells(l, ColunaUsuario).Value = VBA.Environ("username") And Format(wsRef.Cells(l, ColunaData).Value, "dd/mm/yyyy") = Format(Now, "dd/mm/yyyy") Then
            For Each ws In ThisWorkbook.Worksheets
                ws.Protect Senha
            Next
            Exit Sub
        End If
    Next l
        For Each ws In ThisWorkbook.Worksheets
                ws.Unprotect Senha
        Next
End Sub

provavelmente em Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) ja exista algo.... se ja existir adicione o codigo acima no final do codigo existente

Boa tarde,

Antes de mais agradeço imenso a ajuda.
Infelizmente tenho poucos conhecimentos em vba. Testei o código (com as devidas alterações no nome das plan) mas nada acontece. Inseri várias informações seguidas, por exemplo com o meu nome, e foram todas inseridas na tabela da plan2. O que quero é evitar isso mesmo, e que cada pessoa possa só inserir uma informação por dia. Depois do seu nome constar na tabela da plan2 nesse dia já não ser possível (ou pelo menos avisar) que já existe registo para esse dia dessa pessoa. Espero estar a ser entendida.

Onde voce colocou o codigo? voce precisa colocar em Esta pasta de trabalho e alterar a parte editavel no codigo de acordo com a sua planilha.

caso voce prefira poste um modelo da sua plan que eu adiciono la pra voce.

Abraços...

coloca numa celula qualquer uma verificacao tipo
=somarproduto(--(a1=plan2!a:a)*(b1=plan2!b:b))
sendo:
a1 nome e plan2!a:a a coluna dos nomes registrados
b1 data e plan2!b:b coluna das datas

e no vba if "celula de verificacao" == 1
msgbox ("texto de erro")
exit sub

Ajustei uma planilha aqui do forum para esta funcionalidade, veja se ajuda.

lipetom, realmente não tinha inserido o código no lugar correcto. Inseri na plan2. Voltei a alterar e coloquei em Esta pasta trabalhado e também não está a resultar. Vi o seu arquivo, entendi a sua ideia, mas não era bem isso que pretendia.

Também com a ajuda do Pexis não consegui. Por isso, irei enviar um esboço do arquivo para que possam avaliar. Obrigada.

Bom Dia,

Agora entendi....

Altere o codigo do modulo gravar para este
pode apagar todos os outros codigos do projeto

Sub Gravar()
Dim Data As Date
Dim Funcionario As String
Dim Cliente As String
Dim HorasTotais As Double

Dim UltimaCel As Integer

Dim RespostaConfirmaçãoAZero As Integer


 Data = Range("G1").Value
 Funcionario = Range("B3").Value
 Cliente = Range("B5").Value
 HorasTotais = Range("C9").Value
    If Range("c9") = 0 Then
        RespostaConfirmaçãoAZero = MsgBox("Confirmar as Horas Totais de Hoje a 0 (zero)?", vbYesNo + vbQuestion, "Confirmação")
        If RespostaConfirmaçãoAZero = vbNo Then
        MsgBox "Insira as horas correctamente!", vbOKOnly + vbExclamation, "Correcção de Horas"
        Exit Sub
        End If
    End If
 
 
Sheets("Plan2").Select

UltimaCel = Range("A1000000").End(xlUp).Row + 1

 If VerificarExist(Funcionario, Data) = False Then
    Range("A" & UltimaCel).Value = Data
    Range("B" & UltimaCel).Value = Funcionario
    Range("C" & UltimaCel).Value = Obra
    Range("D" & UltimaCel).Value = Cliente
    Range("E" & UltimaCel).Value = HorasTotais
    Else
    MsgBox "Os Dados não Foram Gravados!", vbOKOnly + vbInformation, "Gravação de Dados"
    Exit Sub
 End If


Sheets("Plan1").Select

  
Range("B7").Value = ""
Range("C9").Value = ""


ActiveWorkbook.Save
  
MsgBox "Gravado com Sucesso!", vbOKOnly + vbInformation, "Gravação de Dados"


End Sub

Function VerificarExist(ByVal FuncRef As String, ByVal DataRef As String) As Boolean
Dim wsRef As Worksheet
    dim ColunaUsuario As Long, ColunaData As Long

    '''''''''''''''''''Parte Editavel'''''''''''''''''''''''''''''''''
    Set wsRef = Sheets("Plan2")  'Nome da Planilha de historico
    ColunaUsuario = 2             'Coluna dos Usuarios no historico
    ColunaData = 1                'Coluna das Datas no historico
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Ultimalinha = wsRef.Range("A1000000").End(xlUp).Row
    For l = 1 To Ultimalinha
        If wsRef.Cells(l, ColunaUsuario).Value = VBA.Environ("username") And Format(wsRef.Cells(l, ColunaData).Value, "dd/mm/yyyy") = Format(Now, "dd/mm/yyyy") Then
            msgtrue = MsgBox("Foram Encontrados dados para este funcionario na data de hoje, deseja prosseguir?", vbYesNo, "")
            If msgtrue = 6 Then
                VerificarExist = False
                Exit Function
            Else
                VerificarExist = True
                Exit Function
            End If
            
        End If
    Next l
    VerificarExist = False
End Function

Que coisa... Agora dá esse erro aí... Mudei todo o código da macro e coloquei o que vc enviou.Também tentei coloca-lo no arquivo completo - o mesmo erro.
Como estou em Portugal, não sei se terá a ver com algumas diferenças do excel no Brasil e do excel em Portugal. Existem algumas diferenças na sintaxe das formulas, por exemplo.

tenta ir em tools depois references e manda um print, ou testa a plan em anexo

célula de verificação G15 (ocultar depois) e um texto de alerta na F3 (pode retirar se preferir), retirei o modulo e coloquei a macro no "Estelivro"
tb comentei no codigo a inserção na coluna C pq Obra não estava definido...

Muito obrigada a ambos, lipetom e Pexis

As duas planilhas que enviaram funcionam na perfeição, é mesmo isto! Resta agora eu colocar tudo na planilha completa e funcionar. Já tentei muito rapidamente e não funcionou... Irei faze-lo com mais calma e tentar descobrir onde estão os erros.

Também já alterei os vistos em References>VBA Project.

Assim como funcionou na planilha que vcs enviaram, também tem que funcionar na minha planilha completa.

Mais uma vez, obrigada.

Não consegui colocar a macro a funcionar, alterando com o código do lipetom. Alterei a localização das células originais e não acontece nada. Já verifiquei mas não consigo identificar o problema.

Em relação à ajuda do Pexis, consegui!! Só falta agora colocar a condição. No caso que o Pexis enviou, não é possível nova inserção de dados para um funcionário. Como devo estar, novamente a fazer algo de errado, não consigo colocar ao critério da pessoa prosseguir ou não.

sub Gravar()
Dim Data As Date
Dim Funcionario As String
Dim Cliente As String
Dim HorasTotais As Double

Dim UltimaCel As Integer

Dim RespostaConfirmaçãoAZero As Integer

'agora queria colocar a condição, caso a pessoa clicar em Sim, a macro continua, caso clique em Não, a macro pára. coloquei assim (mas ela grava sempre):

    If Range("G15").Value = 1 Then
        MsgBox ("Funcionário já cadastrado no dia. Deseja prosseguir?"), vbYesNo + vbQuestion, "Confirmação"
        'If vbQuestion = vbNo Then -- agora queria colocar a condição, caso a pessoa clicar em Sim, a macro continua, caso clique em Não, a macro pára.'
        Exit Sub
        Else
        End If
    End If

        Exit Sub
    End If
 Data = Range("G1").Value
 Funcionario = Range("B3").Value
 Cliente = Range("B5").Value
 HorasTotais = Range("C9").Value
    If Range("c9") = 0 Then
        RespostaConfirmaçãoAZero = MsgBox("Confirmar as Horas Totais de Hoje a 0 (zero)?", vbYesNo + vbQuestion, "Confirmação")
        If RespostaConfirmaçãoAZero = vbNo Then
        MsgBox "Insira as horas correctamente!", vbOKOnly + vbExclamation, "Correcção de Horas"
        Exit Sub
        End If
    End If
 
 
Sheets("Plan2").Select

UltimaCel = Range("A1000000").End(xlUp).Row + 1


 Range("A" & UltimaCel).Value = Data
 Range("B" & UltimaCel).Value = Funcionario
 'Range("C" & UltimaCel).Value = Obra
 Range("D" & UltimaCel).Value = Cliente
 Range("E" & UltimaCel).Value = HorasTotais
 


Sheets("Plan1").Select

  
Range("B7").Value = ""
Range("C9").Value = ""


ActiveWorkbook.Save
  
MsgBox "Gravado com Sucesso!", vbOKOnly + vbInformation, "Gravação de Dados"


End Sub

Há também outra questão que queria colocar. Não há forma da macro ficar mais rápida, é que tornou-se algo lenta. Obrigada.

Já consegui colocar a condição. Alguma ideia para a macro ficar mais rápida?

Gostaria ainda de pedir ajuda para colocar o valor de duas células no email automático criado pela seguinte macro (onde na coluna E, sempre que é adicionado um valor acima de 8, envia email alertando):

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim Email_Subject, Email_Send_From, Email_Send_To, _
    Email_Body As String
    Dim Mail_Object, Mail_Single As Variant
           

Email_Subject = "Alerta Automático"
Email_Send_From = "meu email"
Email_Send_To = "email destino"
Email_Body = "Mensagem automática. Foram inseridos dados novos. Validar informação!" '---a ideia é colocar no texto do email, numa linha abaixo, o dado novo da coluna2 e da coluna5, sempre que o tal valor superior a 8 for adicionado.

    
    Application.EnableEvents = False
    If Not Intersect(Target, Range("E4:E1000000")) Is Nothing Then
    Select Case Target
    Case Is > 8
    Application.EnableEvents = True
    End Select
    End If
    
   
On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
    With Mail_Single
    .Subject = Email_Subject
    .To = Email_Send_To
    .Body = Email_Body
    .send
    End With
debugs:
If Err.Description <> "" Then MsgBox Err.Description

End Sub

Cumprimentos.