AW: wenn Ja dann Datum heute
03.06.2016 18:50:54
Mario
Hallo Werner,
das ist doch nicht so schlimm. Ich bin doch über Jede Hilfe Dankbar.
Leider funktioniert es nicht so, folgende Fehler Meldung bekomme ich
Microsoft Visual Basic for Application
Fehler beim Kompilieren:
Mehrdeutiger Name: Worksheet_Change
Das steht in der Tabelle(Daten) als Code:
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim lrow, zRow As Long
lrow = Sheets("Daten").Range("A65536").End(xlUp).Row
zRow = Sheets("Tabelle3").Range("A65536").End(xlUp).Row + 1
Set Bereich = Sheets("Daten").Range("K3:K" & lrow) '*** hier eintragen wo das Datum steht
If Not Intersect(Target, Bereich) Is Nothing Then
If IsDate(Target.Value) = True And Target.Value "" Then
With Range("A" & Target.Row & ":F" & Target.Row) '*** hier eintragen was kopiert werden _
soll
.Copy Destination:=Sheets("Tabelle3").Range("A" & zRow)
Application.EnableEvents = False
.Delete shift:=xlShiftUp
End With
End If
Application.EnableEvents = True
'Cancel = True
End If
End Sub
Public Sub Sortieren(ByVal lrow As Long)
Sheets(1).Range("A3:F" & lrow).Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets(1).Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim loLetzte As Long
If Target.Row > 2 And Target.Column = 10 Then
If Target.Count > 1 Then Exit Sub
loLetzte = Sheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Row + 1
If Target = "ja" Then
Target.Offset(, 1) = Date
Target.EntireRow.Copy Sheets("Tabelle3").Cells(loLetzte, 1)
Target.EntireRow.Delete
End If
End If
End Sub
Ich hoffe du kannst mir weiter Helfen.
Gruß Mario