Suchen Auschneiden einfügen

Public Sub ArtSuchenZeileVerschieben()
Dim QuellWB, ZielWB As Workbook
Dim QuellTab, ZielTab As Worksheet
Dim Zellchen As Range
Set QuellWB = Workbooks("Bestand 111107.xlsx")
Set ZielWB = Workbooks("ArtikelRech.xlsm")
Set QuellTab = QuellWB.Worksheets("111107")
Set ZielTab = ZielWB.Worksheets("Tabelle2")
For Each Zellchen In ZielTab.Range("A2:A" & ZielTab.UsedRange.Rows.Count)
Debug.Print Zellchen.Address
If Not QuellTab.Range("B2:B" & QuellTab.UsedRange.Rows.Count).Find(QuellTab.Text) Is  _
Nothing Then
Debug.Print "Gefunden: " & Zellchen.Address & " in " & QuellTab.Range("B2:B" & QuellTab. _
_
UsedRange.Rows.Count).Find(Zellchen.Text).Address
QuellTab.Range("B2:B" & QuellTab.UsedRange.Rows.Count).Find(Zellchen.Text).EntireRow. _
Cut Zellchen.EntireRow
End If
Next
End Sub