Option Explicit
Sub Test()
Dim rngColumn As Excel.Range
Dim rngCell As Excel.Range
Dim rngResult As Excel.Range
With Worksheets("Tabelle1")
Set rngColumn = .Cells(.Rows.Count, "B").End(xlUp)
Set rngColumn = .Range(rngColumn.End(xlUp).Offset(1), rngColumn)
End With
For Each rngCell In rngColumn.Cells
Set rngResult = Worksheets("Tabelle2").Columns("B").Find( _
What:=rngCell.Value, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
MatchCase:=False)
If Not rngResult Is Nothing Then
Call rngResult.Offset(0, -1).Cut
Call rngCell.Worksheet.Paste(rngCell.Offset(0, -1))
End If
Next
End Sub