Tabellen vergleichen

Sub von1nach3wennIn2()
Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet
Dim rng As Range, rFind As Range
Dim lastRow As Long, lrow As Long
Dim sFirst As String
Set wks1 = Sheets("Tabelle1")
Set wks2 = Sheets("Tabelle2")
Set wks3 = Sheets("Tabelle3")
lastRow = IIf(wks2.Range("C65536") <> "", 65536, _
wks2.Range("C65536").End(xlUp).Row)
For Each rng In wks2.Range("C1:C" & lastRow)
Set rFind = wks1.Range("C:C").Find(what:=rng, LookIn:=xlValues, lookat:=xlWhole)
If Not rFind Is Nothing Then
sFirst = rFind.Address
Do
lrow = lrow + 1
rFind.EntireRow.Copy wks3.Cells(lrow, 1)
Set rFind = wks1.Range("C:C").FindNext(rFind)
Loop While sFirst <> rFind.Address
End If
sFirst = vbNullString
Set rFind = Nothing
Next
End Sub