Página 1 de 1

Salvar a data de modifcação

Enviado: 15 Jun 2016 às 07:54
por gabrielc
Bom dia, pessoal! Tinha criado este tópico (http://gurudoexcel.com/forum/viewtopic.php?f=7&t=2272) para uma ajuda ... porém já resolvi colocando um VBA:
Código: Selecionar todos
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub
Agora, eu preciso que toda a modificação que eu fizer, além de atualizar a data de modificação, preciso que salve em outra folha... por exemplo: Retirei 5 canetas da célula B5 no dia 15/06/2016, na célula C5, atualizou esta data e na outra folha, na célula A5, salvou a data. Dai a mesma coisa, no dia 16/05/2016, retirei 3 canetas dai na outra folha na célula A6, salvou também...
Alguem consegue dar esse help?

Re: Salvar a data de modifcação

Enviado: 15 Jun 2016 às 09:51
por alexandrevba
Bom dia!!

dessa vez, por favor, click na mãozinha!!
Código: Selecionar todos
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Dim lngLastRow As Long
    lngLastRow = Sheets("Plan2").Range("A" & Rows.Count).End(xlUp).Row

Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
            'Tente algo assim....
            ActiveCell.Offset(-1, 0).Copy Destination:=Worksheets("Plan2").Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub
Att