Hallo

will man ein möglichst gutes Programm schreiben und nicht lapidar den Rat geben: -  Google mal im Internet, da findest du alles, dauert es seine Zeit!

Schau dir das Ergebnis bitte mal an und sage mir ob du den Code so perfekt im Netz finden kannst.  Ich glaube nicht ... (fast alles ist möglich bei VBA)

mfg Nobody

Sub Zellen_vergleichen()
Dim b As Long, c As Long, n As Long, Txt
Dim AC As Range, lz1 As Long, lz2 As Long
Dim Tb2 As Worksheet, rFind As Range
Set Tb2 = Worksheets("Tabelle2")    '**  Bitte Namen prüfen

With Worksheets("Tabelle1")         '**  Bitte Namen prüfen
    lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
    lz2 = Tb2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    '** Alle Markierungen in Tabelle vorher löschen!!
    Tb2.Columns("B:C").Interior.Color = xlNone          '** eins von beiden auswählen
    Tb2.Columns("B:C").Font.ColorIndex = xlAutomatic
    'Application.ScreenUpdating = False
 
    'Schleife zum suchen von Daten in Tabelle2 Spalte A
    For Each AC In .Range("A2:A" & lz1)
       AC.Select
        Set rFind = Tb2.Columns(1).Find(What:=AC, After:=[a1], LookIn:=xlFormulas, LookAt:= _
            xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True)

        If Not rFind Is Nothing Then    'Wert gefunden
            'bei gefunden zuerst in Spalte B Wert prüfen  (<> Werte markieren)
            If AC.Cells(1, 2) <> rFind.Cells(1, 2) Then
               rFind.Cells(1, 2).Value = AC.Cells(1, 2).Value
               rFind.Cells(1, 2).Font.ColorIndex = 3        '** oder Interior.Colorindex
               b = b + 1   'Markiert Zähler
            End If
            'bei gleichem Wert in B Spalte C vergleichen
            If AC.Cells(1, 2) = rFind.Cells(1, 2) Then
               If AC.Cells(1, 3) <> rFind.Cells(1, 3) Then
                  rFind.Cells(1, 3).Value = AC.Cells(1, 3).Value
                  rFind.Cells(1, 3).Font.ColorIndex = 3     '** oder Interior.Colorindex
                   c = c + 1   'Markiert Zähler
                End If
            End If
        Else  'Wert wurde nicht gefunden!!
           '(Spalte A-C kopieren, unten anhängen
           AC.Resize(1, 3).Copy Tb2.Cells(lz2, 1)
           lz2 = lz2 + 1:  n = n + 1     'next Zeile
        End If
    Next AC

    If b > 0 Then Txt = b & "  in Spalte B markiert" & vbLf
    If c > 0 Then Txt = Txt & c & "  in Spalte C markiert" & vbLf
    If n > 0 Then Txt = Txt & n & "  neue Werte unten angehangen"
    If b + c + n = 0 Then Txt = "Alle Werte stimmen überein!!"
    
     MsgBox Txt  'Meldung ausgeben
End With
End Sub