Al borrar la celda que se borre la fecha
Buenos días
Al borrar las celdas necesitaría, que se borrase la fecha de la celda correspondiente:
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' AGREGAR FECHA EN UNA COLUMNA
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
If Target.Column = 2 Then
If Cells(Target.Row, "A") = "" Then
Cells(Target.Row, "A") = Date
End If
End If
If Target.Column = 4 Then
If Cells(Target.Row, "C") = "" Then
Cells(Target.Row, "C") = Date
End If
End If
If Target.Column = 6 Then
If Cells(Target.Row, "E") = "" Then
Cells(Target.Row, "E") = Date
End If
End If
If Target.Column = 8 Then
If Cells(Target.Row, "G") = "" Then
Cells(Target.Row, "G") = Date
End If
End If
If Target.Column = 10 Then
If Cells(Target.Row, "I") = "" Then
Cells(Target.Row, "I") = Date
End If
End If
If Target.Column = 12 Then
If Cells(Target.Row, "K") = "" Then
Cells(Target.Row, "K") = Date
End If
End If
If Target.Column = 14 Then
If Cells(Target.Row, "M") = "" Then
Cells(Target.Row, "M") = Date
End If
End If
If Target.Column = 16 Then
If Cells(Target.Row, "O") = "" Then
Cells(Target.Row, "O") = Date
End If
End If
If Target.Column = 18 Then
If Cells(Target.Row, "Q") = "" Then
Cells(Target.Row, "Q") = Date
End If
End If
If Target.Column = 20 Then
If Cells(Target.Row, "S") = "" Then
Cells(Target.Row, "S") = Date
End If
End If
If Target.Column = 22 Then
If Cells(Target.Row, "U") = "" Then
Cells(Target.Row, "U") = Date
End If
End If
End Sub
Un saludo
1 Respuesta
Tendrás que ajustar cada tramo dejándolo tal como el código que te dejo para Target.Column = 2.
Lo tenés que repetir para Column = 4, 6 ... hasta 22 . En cada tramo ajusta la letra de la columna:
Private Sub Worksheet_Change(ByVal Target As Range) 'Por.Dante Amor -ajustes Elsamatilde '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- ' AGREGAR FECHA EN UNA COLUMNA '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- If Target.Column = 2 Then If Target.Value = "" Then Cells(Target.Row, "A") = "" ElseIf Cells(Target.Row, "A") = "" Then Cells(Target.Row, "A") = Date End If End If
Y sinó mejor utiliza esta otra macro (podés probarla en una copia y si responde a lo que necesitas debes dejar esta sola, no las 2)
Private Sub Worksheet_Change(ByVal Target As Range) 'x Elsamatilde '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- ' AGREGAR FECHA EN UNA COLUMNA anterior si se encuentra vacía '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- If Target.Column = 2 Or Target.Column = 4 Or Target.Column = 6 Or Target.Column = 8 Or _ Target.Column = 10 Or Target.Column = 12 Or Target.Column = 14 Or Target.Column = 16 Or _ Target.Column = 18 Or Target.Column = 20 Or Target.Column = 22 Then 'si se borra la celda también se borra la de la col anterior If Target.Value = "" Then Cells(Target.Row, Target.Column - 1) = "" 'si se modifica y la celda anterior está vacía se coloca la fecha ElseIf Cells(Target.Row, Target.Column - 1) = "" Then Cells(Target.Row, Target.Column - 1) = Date End If End If End Sub
No está de más que te comente que en tu macro original solo se coloca la fecha la 1ra vez que ingresas un dato.... cuando modificas un dato ya escrito, por ej sobreescribiendo en celda B2, la fecha de A2 no se actualiza.
