Option Explicit

Private Const mc_MsgTitle As String = "VB-fun-Demo"

Private Function CompareDataWithFindNext( _
            ByVal objWksData1 As Worksheet, _
            ByVal objWksData2 As Worksheet, _
            ByVal objWkbAddWksTo As Workbook) As Boolean

  Const cstrWksFound    As String = "DatenInTab1UndTab2"
  Const cstrWksMissing  As String = "DatenInTab2NichtInTab1"

  Dim objWksDataFound   As Worksheet
  Dim objWksDataMissing As Worksheet

  Dim nRow        As Long
  Dim nRowsCnt    As Long
  Dim nRowsF      As Long
  Dim nRowsM      As Long

  Dim strFind     As String
  Dim objRngCell  As Range
  Dim strCellAdr  As String

  On Error GoTo err_CompareData

  Application.ScreenUpdating = False

  With objWksData2
      nRowsCnt = .Cells(.Rows.Count, 1).End(xlUp).Row
  End With
  If nRowsCnt < 2 Then
      Err.Raise vbObjectError + 513
  End If

  Set objWksDataFound = AddWorksheet(objWkbAddWksTo, _
        cstrWksFound)
  objWksData1.Rows(1).EntireRow.Copy _
        Destination:=objWksDataFound.Cells(1, 1)

  Set objWksDataMissing = AddWorksheet(objWkbAddWksTo, _
        cstrWksMissing)
  objWksData1.Rows(1).EntireRow.Copy _
        Destination:=objWksDataMissing.Cells(1, 1)

  nRowsF = 2
  nRowsM = 2

  For nRow = 2 To nRowsCnt
    strFind = objWksData2.Cells(nRow, 1).Value

    With objWksData1.Columns(1)
      Set objRngCell = .Find(strFind, LookIn:=xlValues, _
            LookAt:=xlWhole)

      If objRngCell Is Nothing Then
        objWksData2.Rows(nRow).EntireRow.Copy _
              Destination:=objWksDataMissing.Cells(nRowsM, 1)

        nRowsM = nRowsM + 1

      Else
        strCellAdr = objRngCell.Address
        Do
          objWksData1.Rows(objRngCell.Row).EntireRow.Copy _
                Destination:=objWksDataFound.Cells(nRowsF, 1)

          nRowsF = nRowsF + 1

          Set objRngCell = .FindNext(objRngCell)
        Loop While (Not objRngCell Is Nothing) And _
              (objRngCell.Address <> strCellAdr)
      End If
    End With
  Next

  objWksDataFound.Activate
  CompareDataWithFindNext = True

exit_Func:
  On Error GoTo 0

  Set objWksData1 = Nothing
  Set objWksData2 = Nothing
  Set objWksDataFound = Nothing
  Set objWksDataMissing = Nothing
  Set objWkbAddWksTo = Nothing

  Application.ScreenUpdating = True
  Exit Function

err_CompareData:
  Select Case Err.Number
    Case vbObjectError + 513
      MsgBox "Keine Daten zum Vergleich!", _
            vbInformation, mc_MsgTitle

    Case Else
      MsgBox Err.Description, vbCritical, mc_MsgTitle
  End Select
  Resume exit_Func
End Function

Private Function AddWorksheet(ByVal objWkb As Workbook, _
      ByVal sWksName As String) As Worksheet

  On Error Resume Next
  Dim objWks As Worksheet

  With objWkb
    Application.DisplayAlerts = False
    objWkb.Worksheets(sWksName).Delete
    Application.DisplayAlerts = True

    Set objWks = objWkb.Worksheets.Add( _
          After:=.Worksheets(.Worksheets.Count))
    objWks.Name = sWksName
    Set AddWorksheet = objWks
  End With

  Set objWks = Nothing
  Set objWkb = Nothing
  On Error GoTo 0
End Function

Public Sub CompareDataInWorksheets()
  On Error GoTo err_CompareWks

  If CompareDataWithFindNext(ActiveWorkbook.Worksheets(1), _
          ActiveWorkbook.Worksheets(2), ActiveWorkbook) Then

    MsgBox "Der Vergleich wurde erfolgreich durchgeführt!", _
          vbInformation, mc_MsgTitle
  End If

exit_Sub:
  On Error GoTo 0
  Exit Sub

err_CompareWks:
  MsgBox Err.Description, vbCritical, mc_MsgTitle
  Resume exit_Sub
End Sub