originele inhoud cel kopieren als inhoud cel veranderd.

[Lampie173]

Beste Allemaal,

over een nieuw te bouwen database heb ik een vraag:

Stel cel A1 bevat een waarde, bv. 10
De waarde in de cel veranderd doordat er in andere waarde in komt bv. 15.

De vraag is:
Hoe krijg ik het voor elkaar dat ik de 1e waarde (10) naar een ander werkblad kopieer en dat vervolgens alle nieuwe getallen vanaf A1 onder elkaar in dat nieuwe werkblad komen te staan.

bv.
Werkblad 1
A1= 10
A1 wordt 15
A1 wordt 21
enz.

Op Werkblad 2
wordt cel A1 gevuld met 10 als A1 in werkblad 1 gevuld wordt met 15
A2 wordt 15
A3 wordt 21

Een soort datumstempel??

Dank voor het lezen,

Mvg,

Toon

 

[AD1957]

Nagenoeg dezelfde vraag stel je hier: https://www.helpmij.nl/forum/showthread.php/958200-controleren-op-wijzigingen
Je hoeft de code alleen maar aan te passen.

 

[edmoor]

Zet dit eens achter Werkblad 1:

Dim OudeWaarde As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "A1" Then
        Dim LR As Long
        If Target.Value <> OudeWaarde Then
            With Sheets("Blad2")
                LR = .Range("A" & Rows.Count).End(xlUp).Row
                If .Range("A" & LR).Value <> "" Then LR = LR + 1
                .Range("A" & LR) = OudeWaarde
            End With
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address(0, 0) = "A1" Then
        OudeWaarde = Target.Value
    End If
End Sub

Wel eventueel "Blad2" aanpassen.

 

[Lampie173]

@ Ad1957
Sorry!
Dat komt inderdaad overeen!
Totaal vergeten!



@ Edmoor
Dank voor je bericht! Ik ga deze (aangepast) gebruiken.

Deze vraag gaat op slot!

Mvg,

Toon

 

[AD1957]

Is ook al een hele tijd geleden.
hier nog een optie:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nw, old
  If Target.Address(0, 0) = "A1" Then            
    With Application
      .EnableEvents = False
      nw = Target
      .Undo
      old = Target
      Target = nw
      
      If Sheets("Blad2").Range("A1") = "" Then        [COLOR="#008000"]'zonder voorbeeldbestand, misschien is deze If-else niet nodig[/COLOR]
         Sheets("Blad2").Range("A1") = old
      Else
         Sheets("Blad2").Cells(Rows.Count, 1).End(xlUp).Offset(1) = old
      End If
      
      .EnableEvents = True
    End With
  End If
End Sub

 

[VenA]

In de eerste rij van blad2 horen kolomkoppen te staan. Nog beter is het gebruik van een tabel dan hoef je alleen een listrow toe te voegen.

 

[AD1957]

Zo met tabel ?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nw, old
  If Target.Address(0, 0) = "A1" Then
    With Application
      .EnableEvents = False
      nw = Target
      .Undo
      old = Target
      Target = nw

      If old <> "" Then Sheets("Blad2").ListObjects("Tabel_controle").ListRows.Add.Range = old
      
      .EnableEvents = True
    End With
  End If
End Sub