VBA Code
04.02.2020 16:25:57
Stefan
Teil 1 wird zwar komplett ausgeführt aber mit einer Fehlermeldung.
Laufzeitfehler 1004
Die Copy-Methode des Range-Objektes konnte nicht ausgeführt werden.
Er hat aber alles gemacht.
Beim Teil 2 kommt die selbe Meldung und er stoppt beim kopieren.
In beiden Fällen zeigt er mir beim debuggen folgende Zeile im Teil 2 an.
Cells(Target.Row, 1).Resize(1, 41).Copy .Cells(lngRow, 1)
Kann mir irgendjemand sagen was da faul ist?
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
If Target.Column = 32 Then
Cells(Target.Row, 1) = 2 'Status auf 2 setzen
End If
End If
'Teil 1 Projekte in Mappen übergeben und dann löschen
If Not Intersect(Target, Range("AJ4:AJ250")) Is Nothing Then
If MsgBox("Willst du wirklich dieses Projekt an den Einkauf übergeben?", _
vbQuestion Or vbOKCancel, "Abfrage") = vbOK Then
Cells(Target.Row, 1) = 3 'Status auf 3 setzen
With Worksheets("Einkauf")
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Cells(Target.Row, 1).Resize(1, 41).Copy .Cells(lngRow, 1)
'nach Übergabe Zeile löschen in Projektübersicht
Target.EntireRow.Delete
End With
End If
End If
'Teil 2 Projekte in Mappen übergeben und dann löschen
If Not Intersect(Target, Range("AK4:AK250")) Is Nothing Then
If MsgBox("Willst du wirklich dieses Projekt an die Produktion übergeben?", _
vbQuestion Or vbOKCancel, "Abfrage") = vbOK Then
Cells(Target.Row, 1) = 5 'Status auf 5 setzen
With Worksheets("Lager")
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Cells(Target.Row, 1).Resize(1, 41).Copy .Cells(lngRow, 1)
'nach Übergabe Zeile löschen in Projektübersicht
Target.EntireRow.Delete
End With
End If
End If
End Sub