Worksheet_Change mit anschl. Makro

Hallo zusammen,
ich möchte dass Datum und Uhrzeit in Zelle A2 eingetragen werden, wenn in Zelle B2 etwas manuell eingetragen wird. Anschliessend sollen die Werte aus Range (A2:B2) kopiert und als Werte weiter unten eingefügt werden.
Das Aktualisieren von Zelle A2 funktioniert, aber nicht das anschliessende Kopieren und Einfügen der Werte. Was mache ich da falsch?
Hier das Makro, das ich verwende:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim iRow As Integer
iRow = Target.Row
If Application.Intersect(Target, Range(Cells(2, 2), Cells(iRow, 2))) Is Nothing Then Exit  _
Sub
Cells(iRow, 1) = Now()
Range(Cells(iRow, 1), Cells(iRow, 2)).Copy
Cells(1, 1).Select
Selection.End(xlDown).Select
Cells(ActiveCell.Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(2, 2).Select
Range(Cells(2, 1), Cells(2, 2)).ClearContents
ActiveWorkbook.Save
End Sub

Vielen Dank schon Vorab für Eure Hilfe!
Gruss
Claus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$2" Then Application.EnableEvents = False Cells(2, 1) = Now() ' geht doch eh nur, wenn B2 Range(Cells(2, 1), Cells(2, 2)).Copy Cells(1, 1).End(xlDown).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues Range(Cells(2, 1), Cells(2, 2)).ClearContents Application.EnableEvents = True ' ActiveWorkbook.Save "'" wieder entfernen... End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) = "B2" Then On Error Resume Next Application.EnableEvents = False Dim letzteZeile As Long If Range("B3") = "" Then letzteZeile = 3 Else letzteZeile = Range("B2").End(xlDown).Row + 1 End If Cells(letzteZeile, 1) = Now Cells(letzteZeile, 2) = Range("B2") Range("B2").ClearContents Application.EnableEvents = True End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count = 1 And _ Not Intersect(Target, Range("B2")) Is Nothing Then On Error GoTo err Application.EnableEvents = False Range("A" & Me.Cells(Me.Rows.Count, 1).End(xlUp).Row + 1).Value = Now Range("B" & Me.Cells(Me.Rows.Count, 1).End(xlUp).Row).Value = Target.Value Range("B2").Select Range("B2").ClearContents ThisWorkbook.Save End If err: Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

Worksheet_Change mit anschl. Makro

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread