von Zelle in Zelle kopieren, aber nur überschreiben,wenn Bedingung erfüllt

Question

Hallo Forum,

gerne hätte ich es so:

wenn ich in M9 ein Datum schreibe, so soll dieses Datum automatisch in T9 kopiert werden, wenn M9 gelöscht wird, so soll das Datum in T9 erhalten bleiben. Jedoch wenn in M9 ein neues Datum geschrieben wird, so soll das Datum in T9 überschrieben werden. Diese Funktion soll sich ab der Zeile 9 für Reihe M und T abwärts abspielen.

Da ich keinen Plan von VBA hab und diese Aufgabe mich Tage kosten würde, oder unlösbar wäre, fänd ich es schön, wenn das was das Programm da macht kurz erläutert wird.


Mit besten Grüßen

Hajo

Answer 1

Hallo Hajo,

so müsste es funktionieren

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("M9:M65536")) Is Nothing Then
If IsDate(Target.Value) Then Target.Offset(0, 7).Value = Target.Value
End If
Application.EnableEvents = True
End Sub

Gruss
Rainer

Answer 2

Da es bereits in diesem blatt mehrere Makros gibt, tritt folgender Fehler auf:

Fehler beim Kopilieren

Mehrdeutiger Name: Worksheet_Change


Makros:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 13 And Target.Row >= 8 And Target.Row <= 1000 And IsDate(Target) Then
With Worksheets("Legende")
Dim LoLetzte As Long
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 13)), _
.Cells(.Rows.Count, 13).End(xlUp).Row, .Rows.Count) + 1
Rows(Target.Row).Copy .Cells(LoLetzte, 1)
Cells(Target.Row, 10) = ""
Cells(Target.Row, 11) = ""
Cells(Target.Row, 13) = ""
Cells(Target.Row, 14) = ""
Cells(Target.Row, 15) = ""
Cells(Target.Row, 16) = ""
End With
End If
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim varCol: varCol = "J:M"


' Wenn es nur eine best. Spalte sein soll:
' Eine der nachfolgenden Zeilen mit der gewünschten Spalte bestücken und einkommentieren!

' varCol = "I"
' varCol = "J"

If Target.Cells.Count = 1 Then
If varCol = "" Then varCol = Target.Column
If Not Intersect(Target, Columns(varCol)) Is Nothing Then
Cancel = True
Target.Value = Date
End If

End If

End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("M9:M65536")) Is Nothing Then
If IsDate(Target.Value) Then Target.Offset(0, 7).Value = Target.Value
End If
Application.EnableEvents = True
End Sub




Was kann man da machen?

Answer 3

OK, ich habs!

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("M9:M65536")) Is Nothing Then
If IsDate(Target.Value) Then Target.Offset(0, 7).Value = Target.Value
End If
Application.EnableEvents = True
If Target.Column = 13 And Target.Row >= 8 And Target.Row <= 1000 And IsDate(Target) Then
With Worksheets("Legende")
Dim LoLetzte As Long
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 13)), _
.Cells(.Rows.Count, 13).End(xlUp).Row, .Rows.Count) + 1
Rows(Target.Row).Copy .Cells(LoLetzte, 1)
Cells(Target.Row, 10) = ""
Cells(Target.Row, 11) = ""
Cells(Target.Row, 13) = ""
Cells(Target.Row, 14) = ""
Cells(Target.Row, 15) = ""
Cells(Target.Row, 16) = ""
End With
End If
End Sub

Answer 4

Hallo Rainer,

vielen Dank für die schnelle Antwort, funktioniert fabelhaft!


Gruß

Hajo