Note: The other languages of the website are Google-translated. Back to English
Registo de cliente  \/ 
x
or
x
Registe-se  \/ 
x

or

Como preencher automaticamente a data na célula quando a célula adjacente é atualizada no Excel?

Às vezes, ao atualizar uma célula em uma determinada coluna, você pode querer marcar a última data sobre a atualização. Este artigo recomendará um método VBA para resolver esse problema. Quando a célula é atualizada, a célula adjacente será preenchida automaticamente com a data atual imediatamente.

Preencher automaticamente a data atual na célula quando a célula adjacente for atualizada com o código VBA


Preencher automaticamente a data atual na célula quando a célula adjacente for atualizada com o código VBA

Supondo que os dados que você precisa atualizar sejam localizados na coluna B, e quando a célula na coluna B for atualizada, a data atual será preenchida na célula adjacente da coluna A. Veja a captura de tela:

Você pode executar o seguinte código VBA para resolver esse problema.

1. Clique com o botão direito na guia da planilha necessária para preencher automaticamente a data com base na célula atualizada adjacente e clique em Ver código no menu do botão direito.

2. Na janela Microsoft Visual Basic for Applications, copie e cole o código VBA abaixo na janela Code.

Código VBA: preencher automaticamente a data atual em uma célula quando a célula adjacente for atualizada

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Updated by Extendoffice 2017/10/12
    Dim xRg As Range, xCell As Range
    On Error Resume Next
    If (Target.Count = 1) Then
        If (Not Application.Intersect(Target, Me.Range("B:B")) Is Nothing) Then _
            Target.Offset(0, -1) = Date
        Application.EnableEvents = False
        Set xRg = Application.Intersect(Target.Dependents, Me.Range("B:B"))
        If (Not xRg Is Nothing) Then
            For Each xCell In xRg
                xCell.Offset(0, -1) = Date
            Next
        End If
        Application.EnableEvents = True
    End If
End Sub

Notas:

1). No código, B: B significa que os dados atualizados estão localizados na coluna B.
2). -1 indica que a data atual será preenchida na coluna esquerda da coluna B. Se você quiser que a data atual seja preenchida na coluna C, altere -1 para 1.

3. Pressione outro + Q chaves ao mesmo tempo para fechar o Microsoft Visual Basic para Aplicações janela.

A partir de agora, ao atualizar células na coluna B, a célula adjacente na coluna A será preenchida com a data atual imediatamente. Veja a imagem:


Artigos relacionados:


As melhores ferramentas de produtividade para escritório

O Kutools for Excel resolve a maioria dos seus problemas e aumenta sua produtividade em 80%

  • armadilha para peixes: Insira rapidamente fórmulas complexas, gráficos e qualquer coisa que você tenha usado antes; Criptografar células com senha; Criar lista de discussão e enviar emails ...
  • Barra Super Fórmula (edite facilmente várias linhas de texto e fórmula); Layout de leitura (ler e editar facilmente um grande número de células); Colar na faixa filtrada...
  • Mesclar células / linhas / colunas sem perder dados; Dividir o conteúdo das células; Combinar linhas / colunas duplicadas... Evite células duplicadas; Comparar intervalos...
  • Selecione Duplicado ou Único Linhas; Selecione linhas em branco (todas as células estão vazias); Super Find e Fuzzy Find em muitos livros; Seleção aleatória ...
  • Cópia exata Várias células sem alterar a referência da fórmula; Criação automática de referências para várias folhas; Inserir marcadores, Caixas de seleção e mais ...
  • Extrair Texto, Adicionar texto, remover por posição, Remover Espaço; Criar e imprimir subtotais de paginação; Converter entre conteúdo de células e comentários...
  • Super Filtro (salvar e aplicar esquemas de filtro a outras planilhas); Classificação Avançada por mês / semana / dia, frequência e mais; Filtro Especial por negrito, itálico ...
  • Combine pastas de trabalho e planilhas; Mesclar tabelas com base em colunas-chave; Divida os dados em várias folhas; Conversão em lote de xls, xlsx e PDF...
  • Mais de 300 recursos poderosos. Suporta Office / Excel 2007-2019 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Teste gratuito de 30 dias com recursos completos. Garantia de devolução do dinheiro em 60 dias.
guia kte 201905

Guia do Office traz interface com guias para o Office e torna seu trabalho muito mais fácil

  • Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
  • Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
parte inferior da aba do escritório
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Lucas · 1 years ago
    Hi, I am using your code as a reference. I want to ask if it is possible to have the following:
    1. Prevent duplicated date entries
    2. Have the 2 macro inputs at the same time : Target.Offset(0,-1), Target,Offset(0,1)
    3. Possible to auto insert an image to the cell?

    Was trying to figure it out myself but i can't seem to find any resources online which can help me
  • To post as a guest, your comment is unpublished.
    chapo · 1 years ago
    I'm inputting this code into my excel workbook and nothing is happening. Could anyone please help? Ideally, I would like when something is put into column A, time would be put into column B.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi chapo,
      Try the below code. Hope I can help.
      Private Sub Worksheet_Change(ByVal Target As Excel.Range) 'Updated by Extendoffice 2020/10/12 Dim xRg As Range, xCell As Range On Error Resume Next If (Target.Count = 1) Then If (Not Application.Intersect(Target, Me.Range("A:A")) Is Nothing) Then _ Target.Offset(0, 1) = Time Application.EnableEvents = False Set xRg = Application.Intersect(Target.Dependents, Me.Range("A:A")) If (Not xRg Is Nothing) Then For Each xCell In xRg xCell.Offset(0, 1) = Time Next End If Application.EnableEvents = True End If End Sub

  • To post as a guest, your comment is unpublished.
    ashish_1794 · 1 years ago
    I do not want to enter date but a constant value in the cell, eg: a number or a text string. please suggest the code changes for the same.

    Thanks
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi,
      If you want to enter a number, please replace the text Date with the number directly in the code. For enter a text string, please replace the text Date in the code with "you text string" (the double quotes are included).

      Private Sub Worksheet_Change(ByVal Target As Excel.Range) 'Updated by Extendoffice 2020/09/28 Dim xRg As Range, xCell As Range On Error Resume Next If (Target.Count = 1) Then If (Not Application.Intersect(Target, Me.Range("B:B")) Is Nothing) Then _ Target.Offset(0, -1) = "a text string" 'Or directly enter a number Application.EnableEvents = False Set xRg = Application.Intersect(Target.Dependents, Me.Range("B:B")) If (Not xRg Is Nothing) Then For Each xCell In xRg xCell.Offset(0, -1) = "a text string" 'Or directly enter a number Next End If Application.EnableEvents = True End If End Sub
  • To post as a guest, your comment is unpublished.
    iLadyT · 1 years ago
    Does anyone know if there is a way to auto-populate and lock to prevent inputter from changing the date? When I lock the cells and protect the document then the cells do not populate at all.
  • To post as a guest, your comment is unpublished.
    Ryan · 2 years ago
    i think a change is needed to line 7 as well...
  • To post as a guest, your comment is unpublished.
    Harry · 2 years ago
    Hello, is there a way to make column (A) automatically populated with a date when entering a value into any cell in the same row?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Harry,
      The below VBA code can help you solve the problem. Please specify the range as much as possible in the code. Thank you for your comment.

      Private Sub Worksheet_Change(ByVal Target As Excel.Range)
      'Updated by Extendoffice 20191017
      Dim xRg As Range, xCell As Range
      Dim xInt As Integer
      On Error Resume Next
      If (Target.Count = 1) Then
      If (Not Application.Intersect(Target, Me.Range("B:BP")) Is Nothing) Then
      Application.EnableEvents = False
      xInt = Target.Row
      Me.Range("A" & xInt).Value = Date
      Application.EnableEvents = True
      End If
      End If
      End Sub
  • To post as a guest, your comment is unpublished.
    Abbey · 2 years ago
    Hello, Can I set the date and the time to populate?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Abbey,
      In the above code, please replace this line
      "xCell.Offset(0, -1) = Date"
      with
      "xCell.Offset(0, -1) = Format(Now(), "yyyy-MM-dd hh:mm:ss")".
      Hope I can help. Thank you for your comment.
      • To post as a guest, your comment is unpublished.
        Ryan · 2 years ago
        this didnt add the time in... is there another way?
        • To post as a guest, your comment is unpublished.
          Rizwan · 2 years ago
          you have to change it at 2 places, if you see original code, date is at 2 places, change both with Format(Now(), "yyyy-MM-dd hh:mm:ss")
  • To post as a guest, your comment is unpublished.
    josmpete · 2 years ago
    Hello, I need some help. I am trying to populate the current date into column A if any cells B through N are modified. The offset is throwing me off. Can this code be written to auto populate the date in Column A specifically?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Joe,
      The below VBA code can help you solve the problem. Please have a try and thank you for your comment.

      Private Sub Worksheet_Change(ByVal Target As Excel.Range)
      'Updated by Extendoffice 20190924
      Dim xRg As Range, xCell As Range
      Dim xInt As Integer
      On Error Resume Next
      If (Target.Count = 1) Then
      If (Not Application.Intersect(Target, Me.Range("B:N")) Is Nothing) Then
      Application.EnableEvents = False
      xInt = Target.Row
      Me.Range("A" & xInt).Value = Date
      Application.EnableEvents = True
      End If
      End If
      End Sub
  • To post as a guest, your comment is unpublished.
    GBiermann · 2 years ago
    Hi. I'm trying to use the "Auto Populate Current Date In Cell When Adjacent Cell Is Updated With VBA Code". This works on Sheet 1, but I have 11 other sheets I need the code to work on. Please advise. I'm not VBA saavy at all so I appreciate any help I can get!

    Thanks.
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Gwen,
      Please repeat the steps to copy the code to other sheets. It may be tedious, but it works.
  • To post as a guest, your comment is unpublished.
    yekim25 · 3 years ago
    I used this code to auto populate a column and now wish to auto populate more columns based on date entered into column H. In other words, once a date is entered can I auto populate columns to add date 90, 60, and 30 days out?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Tracey,
      The following VBA code can help you solve the probem. Please have a try.

      Private Sub Worksheet_Change(ByVal Target As Excel.Range)
      Dim xRg As Range, xCell As Range
      Dim xRgAddress As String
      xRgAddress = "H:H"
      On Error Resume Next
      If (Target.count = 1) Then
      If (Not Application.Intersect(Target, Me.Range(xRgAddress)) Is Nothing) Then
      Target.Offset(0, 1) = Date + 90
      Target.Offset(0, 2) = Date + 60
      Target.Offset(0, 3) = Date + 30
      End If
      Application.EnableEvents = False
      Set xRg = Application.Intersect(Target.Dependents, Me.Range(xRgAddress))
      If (Not xRg Is Nothing) Then
      For Each xCell In xRg
      xCell.Offset(0, 1) = Date + 90
      xCell.Offset(0, 2) = Date + 60
      xCell.Offset(0, 3) = Date + 30
      Next
      End If
      Application.EnableEvents = True
      End If
      End Sub
  • To post as a guest, your comment is unpublished.
    Jen · 3 years ago
    Nevermind...I tried John's response below and it works - thank you!
  • To post as a guest, your comment is unpublished.
    Jen · 3 years ago
    HI - new to VBA - I want to loop the code - VBA code: auto populate current date in a cell when the adjacent cell is updated so that after a cell is updated with a date, then move on to say "J:J" and update K with date and then do 2 more times. Not sure if it is a loop or for? Thank you
  • To post as a guest, your comment is unpublished.
    srirevathi555@gmail.com · 4 years ago
    Hi,

    Can anyone one suggest a code for when I input number in column A and Column B and in Column C I kept a formula like Column A + Column B. Now I need a vba code that can give time and date in Column D whenever Column C changes not when inserting numbers in Column A and B.
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Good Day,
      Any question about Excel, please don’t hesitate to post in our forum: https://www.extendoffice.com/forum.html.
      You will get more supports about Excel from our Excel professional.
  • To post as a guest, your comment is unpublished.
    Sarah · 4 years ago
    Are you able to use this function twice on the same sheet? i.e. if I would like to make entries in column B to time stamp column A AND put entries in column D to timestamp column C. Thanks!
    • To post as a guest, your comment is unpublished.
      John · 4 years ago
      I got this to work by doing the following:


      Private Sub Worksheet_Change(ByVal Target As Excel.Range)
      'Updated by Extendoffice 2017/10/12
      Dim xRg As Range, xCell As Range
      On Error Resume Next
      If (Target.Count = 1) Then
      If (Not Application.Intersect(Target, Me.Range("B:B")) Is Nothing) Then _
      Target.Offset(0, -1) = Date
      Application.EnableEvents = False
      Set xRg = Application.Intersect(Target.Dependents, Me.Range("B:B"))
      If (Not xRg Is Nothing) Then
      For Each xCell In xRg
      xCell.Offset(0, -1) = Date
      Next
      End If
      Application.EnableEvents = True
      End If


      On Error Resume Next
      If (Target.Count = 1) Then
      If (Not Application.Intersect(Target, Me.Range("D:D")) Is Nothing) Then _
      Target.Offset(0, -1) = Date
      Application.EnableEvents = False
      Set xRg = Application.Intersect(Target.Dependents, Me.Range("D:D"))
      If (Not xRg Is Nothing) Then
      For Each xCell In xRg
      xCell.Offset(0, -1) = Date
      Next
      End If
      Application.EnableEvents = True
      End If
      End Sub
  • To post as a guest, your comment is unpublished.
    joeklein · 4 years ago
    Thanks it works fine, but when it comes to close and save I'm getting a error that the feature "VB project" cannot be saved in a macro-free workbook. Please advise
    • To post as a guest, your comment is unpublished.
      jcivo8 · 4 years ago
      You just need to "save as" a excel macro-enabled workbook....
  • To post as a guest, your comment is unpublished.
    Michael · 4 years ago
    Thanks it works fine, but when it comes to close and save I'm getting a error that the feature "VB project" cannot be saved in a macro-free workbook. Please advise
  • To post as a guest, your comment is unpublished.
    Tammy · 4 years ago
    Can this be accomplished on a cell that contains a formula?
    • To post as a guest, your comment is unpublished.
      crystal · 4 years ago
      Dear Tammy,
      The code has been updated. It can be accomplished on a cell that contains a formula now. Thank you for your comment.
  • To post as a guest, your comment is unpublished.
    leah · 4 years ago
    I have a set of excel worksheets titled monday, tuesday, wednesday, etc. I need to put the beginning date on Monday in cell a1, and have it fill in the subsequent dates for tuesday through Friday in cell a1 on each of those sheets. I am not code literate at all, so I just need to know what the simple formula I can put in there is. :) thank you!
    • To post as a guest, your comment is unpublished.
      crystal · 4 years ago
      Dear leah,
      You just have to use the formula =monday!A1+1 on sheet tuesday, =tuesday!A1+1 on sheet wednesday and so on...
  • To post as a guest, your comment is unpublished.
    Jishnu · 4 years ago
    Thank You. This helped a lot.
    But when I am deleting a row or adding a row this gives an Run-time error 13 Type mismatch.

    How to tackle this issue.

    Expecting a revert ASAP.
    • To post as a guest, your comment is unpublished.
      crystal · 4 years ago
      Dear Jishnu,
      The problem you mentioned does not appear in my case. Would you please provide your Office version?