VBA Code
03.02.2020 06:54:52
Stefan
Ich habe folgenden Code in meiner Tabelle.
Teil 1 funktioniert seit dem ich Teil 2 hinzugefügt habe geht es nicht mehr.
Ich kann leider den Fehler nicht finden.
'Datum einfügen bei Doppelklick
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lngRow As Long
If Not Intersect(Target, Range("AF4:AK250")) Is Nothing Then
Cancel = True
Target = Date
End If
'Status auf 2 setzen
If Not Intersect(Target, Range("AF4:AF250")) Is Nothing Then
Target.Offset(0, 1 - Target.Column) = 2
End If
'Teil 1 Projekte in Mappen übergeben und dann löschen
If Not Intersect(Target, Range("AJ4:AJ250")) Is Nothing Then
Cancel = True
If MsgBox("Willst du wirklich dieses Projekt an den Einkauf übergeben?", vbQuestion Or _
_
vbOKCancel, "Abfrage") = vbOK Then
Target = Date
'Status auf 3 setzen
If Not Intersect(Target, Range("AJ4:AJ250")) Is Nothing Then
Target.Offset(0, 1 - Target.Column) = 3
With Worksheets("Einkauf")
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Target.Offset(, -35).Resize(, 41).Copy .Rows(lngRow)
'nach Übergabe Zeile löschen in Projektübersicht
Target.EntireRow.Delete
End With
End If
End If
End If
'Teil 2 Projekte in Mappen übergeben und dann löschen
If Not Intersect(Target, Range("AK4:AK250")) Is Nothing Then
Cancel = True
If MsgBox("Willst du wirklich dieses Projekt an die Produktion übergeben?", vbQuestion _
_
Or vbOKCancel, "Abfrage") = vbOK Then
Target = Date
'Status auf 5 setzen
If Not Intersect(Target, Range("AK4:AK250")) Is Nothing Then
Target.Offset(0, 1 - Target.Column) = 5
With Worksheets("Lager")
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Target.Offset(, -35).Resize(, 41).Copy .Rows(lngRow)
'nach Übergabe Zeile löschen in Projektübersicht
Target.EntireRow.Delete
End With
End If
End If
End If
End Sub