Hallo,
ich habe folgendes Problem. In einer Tabelle möchte ich automatisch eine Zeile in eine andere verschieben und die Orginalzelle soll gelöscht werden. Das klappt soweit sehr gut mit folgendem Code, den ich online gefunden und etwas angepasst habe. Das kopieren der Zeile funktioniert aber nur, wenn ich die Zelle (in dem Fall eine Zelle in Spalte N manuell auf "free" ändere. Ich habe aber eine Funktion in einer anderen Zelle, die den Eintrag der Zelle in Spalte "N" automatisch ändert. Wenn dies geschieht, wird die gewünschte Zeile aber nicht kopiert, also der Code löst nicht aus. Kann mir hierbei jemand weiterhelfen?
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim lRow, zRow As Long
lRow = Sheets("MU3 Product Control").Range("A3000").End(xlUp).Row
zRow = Sheets("Tabelle2").Range("A3000").End(xlUp).Row + 1
Set Bereich = Range("N2:N" & lRow) '*** hier eintragen wo das Datum steht
If Not Intersect(Target, Bereich) Is Nothing Then
If (Target.Value) = "free" And Target.Value <> "" Then
With Range("A" & Target.Row & ":T" & Target.Row) '*** hier eintragen was kopiert werden soll
.Copy
Sheets("Tabelle2").Paste Destination:=Sheets("Tabelle2").Range("A" & zRow)
If IsNumeric(Sheets("Tabelle2").Range("A" & zRow - 1)) = True Then
Sheets("Tabelle2").Range("A" & zRow) = Sheets("Tabelle2").Range("A" & zRow).Offset(-1, 0) + 1
Else
Sheets("Tabelle2").Range("A" & zRow) = 1
End If
Application.EnableEvents = False
.Delete shift:=xlShiftUp
Sheets("MU3 Product Control").Range("A" & lRow).Delete
End With
End If
End If
Application.EnableEvents = True
End Sub
|