Bei Doppelklick Wert einfügen

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
Dim RaBereich As Range
If Not Intersect(Target, Range("A4:K4")) Is Nothing Then
Target.CurrentRegion.Sort _
key1:=Target.Offset(1), _
Order1:=Sheets("Temp").Cells(1, Target.Column) + 1, _
Header:=xlYes
With Sheets("Temp").Cells(1, Target.Column)
.Value = IIf(.Value = 0, 1, 0)
End With
Cancel = True
End If
'##########    x in die Zelle bei Doppelklick   #########
Set RaBereich = Range("E5:F10000")
If Intersect(Target, RaBereich) Is Nothing Then Exit Sub
' Abbruch, wenn Aktion nicht im Zielbereich
Cancel = True
If (Target.Column = 5 And UCase(Target(1).Offset(0, 1))  "X") _
Or (Target.Column = 6 And UCase(Target(1).Offset(0, -1))  "X") Then
If Cells(Target.Row, 4) = "" Then
MsgBox ("Es ist noch keine Palette vorhanden")
Exit Sub
End If
If Target.Value = "X" Then
Target.Value = ""
Else
Target.Value = "X"
End If
Else
MsgBox " Es kann nur ein Packer ausgewählt werden. Entweder A oder B"
End If
Set RaBereich = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub