Zeilen einfügen trotz exit sub
22.05.2016 23:49:48
Oisse
dank Michael habe ich einen prima Code erhalten, den ich dann lediglich etwas erweitert habe.
Wenn gewisse Bedingungen erfüllt sind, sollen Fehlermeldungen erscheinen, ansonsten soll eine neue Zeile unter der aktuellen eingefügt werden mit den Daten der Zeile.
Der Code sieht wie folgt aus:
'Wenn sie die Stückzahlen ändern, also nicht die gesamte Stückzahl verkauft werden konnte,
'dann wird die komplette Zeile kopiert, eine neue Zeile darunter eingefügt mit den kopierten _
Daten
'und anschließend in Spalte 5 der neue Stückzahlenwert eingetragen.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dif As Long
Dim Dif2 As Long
Dim Ur As Long
Dim Ver As Long
Dim Oben As String
Dim Unten As String
Oben = Range("K" & Target.Row) & Range("L" & Target.Row)
Unten = Range("K" & Target.Row + 1) & Range("L" & Target.Row + 1)
' Stop
If Target.Row > 2 And Target.Column = 22 Then
Ur = Cells(Target.Row, 5) 'Angebotene Stückzahl
Ver = Target.Value 'Tatsächlich verkaufte Stückzahl
If Ur Ver Then
Dif = Ur - Ver 'Ermitteln der neuen Stückzahl
If Dif Dif2 Then
MsgBox "Dieser Artikel ist bereits verkauft." & Chr(10) & "Du darfst hier keine Ä _
nderungen mehr vornehmen", vbOKCancel
Target.Value = Dif2
Target.Select
Application.EnableEvents = False
Application.EnableEvents = True
Exit Sub
End If
If Range("V" & Target.Row) = "" Then
Exit Sub
End If
Application.EnableEvents = False
Rows(Target.Row + 1).Insert Shift:=xlDown
Rows(Target.Row).Copy Rows(Target.Row + 1)
Target.Offset(1, -17) = Dif
Target.Offset(1, 0) = ""
Target.Offset(1, 1) = ""
Target.Offset(1, -1) = ""
Target.Offset(1, -2) = ""
Target.Offset(1, -4) = ""
Target.Offset(1, -5) = ""
Target.Offset(1, -6) = ""
Target.Offset(1, -7) = ""
Target.Offset(1, -8) = ""
Target.Offset(1, -9) = ""
Application.EnableEvents = True
Application.CutCopyMode = False
End If
End Sub
Es erscheinen die Fehlermeldungen, auch setzt er die Werte wieder zurück, aber es wird jedesmal eine neue Zeile eingefügt, was ich aber nicht möchte wenn die MsgBox erscheint. Dann soll das Makro abgebrochen werden und eben keine neue Zeile eingefügt werden.
Wie muss ich das ändern? Bin schon den ganzen Abend am rumprobieren und kriegs nicht hin. Wo ist der Fehler?
Gruß Oisse