Code über Command Button nicht über Doppelklick

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim s1 As Worksheet
Dim y1 As Long
Dim s2 As Worksheet
Dim y2 As Long
Dim strArtikel As String
Dim intVon As Integer
Dim intBis As Integer
Dim strBlatt As String
Dim n As Integer
If (Target.Cells.Count = 1) And (Target.Column = 1) And (Target.Row >= 2) Then
Set s1 = ActiveSheet
y1 = Target.Row
strArtikel = s1.Cells(y1, 1).Value
If (strArtikel  "") Then
intVon = s1.Cells(y1, 4).Value
intBis = s1.Cells(y1, 5).Value
If (intBis > intVon) Then
strBlatt = Right$(strArtikel, 4)
Set s2 = Worksheets(strBlatt)
y2 = s2.Cells(s2.Rows.Count, 1).End(xlUp).Row
For n = intVon To intBis
y2 = y2 + 1
s2.Cells(y2, 1).Value = n
Next n
s1.Cells(y1, 8).Value = "ja"
s2.Activate: s2.Cells(y2, 1).Activate
End If
End If
Cancel = True
End If
End Sub