Comment remplir automatiquement la date dans la cellule lorsque la cellule adjacente est mise à jour dans Excel?
Parfois, lors de la mise à jour d'une cellule dans une certaine colonne, vous souhaiterez peut-être marquer la dernière date de mise à jour. Cet article recommandera une méthode VBA pour résoudre ce problème. Lorsque la cellule est mise à jour, la cellule adjacente sera automatiquement remplie avec la date actuelle immédiatement.
Remplir automatiquement la date actuelle dans la cellule lorsque la cellule adjacente est mise à jour avec le code VBA
En supposant que les données que vous devez mettre à jour se trouvent dans la colonne B, et lorsque la cellule de la colonne B est mise à jour, la date actuelle sera renseignée dans la cellule adjacente de la colonne A. Voir capture d'écran:
Vous pouvez exécuter le code VBA suivant pour résoudre ce problème.
1. Cliquez avec le bouton droit sur l'onglet de la feuille dont vous avez besoin pour renseigner automatiquement la date en fonction de la cellule mise à jour adjacente, puis cliquez sur Voir le code dans le menu contextuel.
2. Dans la fenêtre Microsoft Visual Basic pour Applications, copiez et collez le code VBA ci-dessous dans la fenêtre Code.
Code VBA: remplissage automatique de la date actuelle dans une cellule lorsque la cellule adjacente est mise à jour
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
Notes:
1). Dans le code, B: B signifie que les données mises à jour se trouvent dans la colonne B.
2). -1 indique que la date actuelle sera renseignée dans la colonne de gauche de la colonne B. Si vous voulez que la date actuelle apparaisse dans la colonne C, veuillez changer -1 en 1.
3. presse autre + Q clés en même temps pour fermer le Microsoft Visual Basic pour applications fenêtre.
À partir de maintenant, lors de la mise à jour des cellules de la colonne B, la cellule adjacente de la colonne A sera immédiatement remplie avec la date actuelle. Voir la capture d'écran:
Kutools for Excel résout la plupart de vos problèmes et augmente votre productivité de 80%
Réutilisation: Insérer rapidement formules complexes, graphiques et tout ce que vous avez utilisé auparavant; Crypter les cellules avec mot de passe; Créer une liste de diffusion et envoyer des e-mails ...
Barre Super Formula (modifiez facilement plusieurs lignes de texte et de formule); Disposition de lecture (lire et modifier facilement un grand nombre de cellules); Coller dans la plage filtrée...
Fusionner les cellules / lignes / colonnes sans perdre de données; Contenu des cellules divisées; Combiner des lignes / colonnes en double... Empêcher les cellules en double; Comparer les gammes...
Sélectionnez Dupliquer ou Unique Lignes; Sélectionnez les lignes vides (toutes les cellules sont vides); Super Find et Fuzzy Find dans de nombreux classeurs; Sélection aléatoire ...
Copie exacte Plusieurs cellules sans changer la référence de formule; Créer automatiquement des références à plusieurs feuilles; Insérer des puces, Cases à cocher et plus encore ...
Extrait du texte, Ajouter du texte, Supprimer par position, Supprimer l'espace; Créer et imprimer des sous-totaux de pagination; Conversion entre le contenu et les commentaires des cellules...
Super filtre (enregistrer et appliquer des schémas de filtrage à d'autres feuilles); Tri avancé par mois / semaine / jour, fréquence et plus; Filtre spécial par gras, italique ...
Combiner des classeurs et des feuilles de travail; Fusionner les tableaux en fonction des colonnes clés; Diviser les données en plusieurs feuilles; Conversion par lots xls, xlsx et PDF...
Plus de 300 fonctionnalités puissantes. Prend en charge Office / Excel 2007-2019 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Essai gratuit de 30 jours. Garantie de remboursement de 60 jours.
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.
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
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
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.
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
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.
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?
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
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!
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?
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
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
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.
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.
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!
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
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
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
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!
