Option Explicit
Sub vergleichen()
Dim i As Long
Dim j As Long
Dim alt As Object
Dim neu As Object
Dim ende As Long
Dim anzahlalt As Long
Dim zeile As Long
Application.ScreenUpdating = False
Set neu = Worksheets(3)
Set alt = Worksheets(4)
neu.UsedRange.Interior.ColorIndex = xlNone
ende = neu.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To ende
If neu.Cells(i, 1) = "" Then
Else
anzahlalt = Application.WorksheetFunction.CountIf(alt.Columns(1), neu.Cells(i, 1))
If anzahlalt = 0 Then
neu.Range(neu.Cells(i, 1), neu.Cells(i, 26)).Interior.ColorIndex = 6
Else
zeile = Application.WorksheetFunction.Match(neu.Cells(i, 1), alt.Columns(1), 0)
For j = 1 To 26
If alt.cell(zeile, j) <> neu.Cells(i, j) Then neu.Cells(i, j).Interior.ColorIndex = 6
Next j
End If
End If
Next i
Application.ScreenUpdating = True
End Sub