Zeile mittels VBA in EXCEL ausschneiden und in anderem Tabellenblatt einfügen

Option Explicit
Dim wks As Worksheet
Dim wkb1, wkb2 As Workbook
Dim XBlatt, wks2 As Worksheet
Dim XZeile As Long
Dim Suchart As String
Dim xOpt As Integer

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
    Suchart = xlWhole
Else
    Suchart = xlPart
End If
End Sub

Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
    ComboBox1.Enabled = False
Else
    ComboBox1.Enabled = True
End If
End Sub

Private Sub CommandButton1_Click()
Dim xSuche, xAdresse, xErste As String
Dim y As Boolean
Dim arr() As Variant
Dim rng As Range
Dim iCounter, iRowU As Integer

ListBox1.Clear
xSuche = TextBox1.Value
If xSuche = "" Then  
    MsgBox "Bitte erst einen Suchbegriff eingeben!", vbExclamation, "Achtung!"  
    Exit Sub
End If
If ComboBox1.Value = "" And CheckBox2.Value = False Then  
    MsgBox "Bitte geben Sie ein, wo der Begriff gesucht werden soll!", vbExclamation, "Achtung!"  
    Exit Sub
End If
For iCounter = 1 To ThisWorkbook.Sheets.Count
    If CheckBox2.Value = True Or Worksheets(iCounter).Name = ComboBox1.Value Then
        Set rng = Worksheets(iCounter).Cells.Find _
            (xSuche, lookat:=Suchart, LookIn:=xlValues)
        If Not rng Is Nothing Then
            With Worksheets(iCounter)
                xErste = rng.Address(False, False)
                y = True
                Do Until xAdresse = xErste
                    ReDim Preserve arr(0 To 6, 0 To iRowU)
                    arr(0, iRowU) = .Name
                    arr(1, iRowU) = rng.Address(False, False)
                    arr(2, iRowU) = .Cells(rng.Row, 1)
                    arr(3, iRowU) = .Cells(rng.Row, 2)
                    arr(4, iRowU) = .Cells(rng.Row, 3)
                    arr(5, iRowU) = .Cells(rng.Row, 4)
                    arr(6, iRowU) = .Cells(rng.Row, 5)
                    iRowU = iRowU + 1
                    Set rng = .Cells.FindNext(after:=rng)
                    xAdresse = rng.Address(False, False)
                Loop
                xAdresse = ""  
                xErste = ""  
            End With
        End If
    End If
Next iCounter
If y = False Then
    MsgBox "Der Suchbegriff wurde nicht gefunden!"  
Else
    ListBox1.Column = arr
End If
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub CommandButton3_Click()
Dim iCounter, xCounter As Long
Set wkb1 = ThisWorkbook
Set wkb2 = Workbooks.Add(1)
Set wks2 = wkb2.Sheets(1)
wkb1.Activate
For iCounter = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(iCounter) And xOpt = 1 Or xOpt = 2 Then
        Set XBlatt = Sheets(ListBox1.List(iCounter, 0))
        XZeile = Range(ListBox1.List(iCounter, 1)).Row
        xCounter = xCounter + 1
        XBlatt.Rows(XZeile).Copy wks2.Rows(xCounter)
    End If
Next iCounter
wks2.Activate
End Sub

Private Sub CommandButton4_Click()
Dim iCounter, xCounter As Long
Set wkb1 = ThisWorkbook
Set wkb2 = Workbooks.Add(1)
Set wks2 = wkb2.Sheets(1)
wkb1.Activate
For iCounter = ListBox1.ListCount - 1 To 0 Step -1
    If ListBox1.Selected(iCounter) And xOpt = 1 Or xOpt = 2 Then
        Set XBlatt = Sheets(ListBox1.List(iCounter, 0))
        XZeile = Range(ListBox1.List(iCounter, 1)).Row
        xCounter = xCounter + 1
        XBlatt.Rows(XZeile).Copy wks2.Rows(xCounter)
        XBlatt.Rows(XZeile).Delete Shift:=xlUp
        ListBox1.RemoveItem (iCounter)
    End If
Next iCounter
wks2.Activate
End Sub

Private Sub CommandButton5_Click()
Dim iCounter As Long
If MsgBox("Die markierten Daten werden unwideruflich aus dieser Datei gelöscht." & vbLf & _  
            "Wollen Sie fortfahren?", vbOKCancel, "Achtung!") = vbOK Then  
    For iCounter = ListBox1.ListCount - 1 To 0 Step -1
        If ListBox1.Selected(iCounter) And xOpt = 1 Or xOpt = 2 Then
            Set XBlatt = Sheets(ListBox1.List(iCounter, 0))
            XZeile = Range(ListBox1.List(iCounter, 1)).Row
            XBlatt.Rows(XZeile).Delete Shift:=xlUp
            ListBox1.RemoveItem (iCounter)
        End If
    Next iCounter
End If
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.Goto Sheets(ListBox1.List(ListBox1.ListIndex, 0)).Range(ListBox1.List(ListBox1.ListIndex, 1))
End Sub

Private Sub OptionButton1_Click()
xOpt = 1
End Sub

Private Sub OptionButton2_Click()
xOpt = 2
End Sub

Private Sub UserForm_Initialize()
For Each wks In Worksheets
    If wks.Name <> ActiveSheet.Name Then ComboBox1.AddItem wks.Name
Next
Suchart = xlPart
xOpt = 1
End Sub