Sammenligning af to worksheets i Excel

Prøv denne, den laver rød baggrund, hvis de ikke er ens

Public Sub CompareSheets()
    Dim A As Variant, B As Variant
    For I = 1 To Sheets(1).UsedRange.Rows.Count
        A = Sheets(2).Rows(I)
        B = Sheets(1).Rows(I)
        For n = 1 To UBound(A)
            If A(1, n) <> B(1, n) Then
                Sheets(1).Rows(I).Interior.ColorIndex = 3
                Exit For
            End If
        Next
    Next
End Sub

Super - tak for det.
Så skal vi bare have et svar :-)

Øhh.. Samme spørgsmål her?? http://www.eksperten.dk/spm/824866

et svar ;-))

Sammen med et andet svar, og lidt opfindsomhed har jeg udviddet løsningen:
Public Function LastRow(Ark As Worksheet) As Long
    LastRow = Ark.UsedRange.Rows.Count
End Function

Public Function LastColumn(Ark As Worksheet) As Integer
    LastColumn = Ark.UsedRange.Columns.Count
End Function

Sub KontrollerArk()

    Dim FraArk As Worksheet
    Dim TilArk As Worksheet
    Dim FraArk_Rw_Max, TilArk_Rw_Max, RwMax As Long
    Dim FraArk_Col_Max, TilArk_Col_Max, ColMax As Long
    Dim Rw As Long
    Dim Col As Long
    Dim Col2 As Long
    Dim TotalErr As Integer
    Dim RowErr As Integer
    Dim RowErrFlag As Boolean

    'Delete resultsheet
    Application.DisplayAlerts = False
    If Worksheets.Count > 2 Then Worksheets(3).Delete
    Application.DisplayAlerts = True

    ' Create ResultSheet
    Sheets.Add Type:=xlWorksheet, Count:=1, after:=Worksheets(2)
       
    ' Set Worksheets
    Set FraArk = Worksheets(1)      ' Her erstattes Ark 1 med navn på det første Ark
    Set TilArk = Worksheets(2)      ' Her erstattes Ark 1 med navn på det andet Ark
    Set ResultSheet = Worksheets(3) ' Her udskrives resultater,
    ResultSheet.Name = "Results"
   
    'Opbyg ResultSheet
    ResultSheet.Cells(1, 1).Value = "Række"
   
   
    ' Nulstil nuværende markering af ark (farve sættes til blank)
    FraArk.Cells.Interior.ColorIndex = xlNone
    TilArk.Cells.Interior.ColorIndex = xlNone
    ResultSheet.Cells.Interior.ColorIndex = xlNone
   
    ' Definer værdierne for arket (hvor mange rækker og kolonner)
    FraArk_Rw_Max = LastRow(FraArk)
    TilArk_Rw_Max = LastRow(TilArk)
    FraArk_Col_Max = LastColumn(FraArk)
    TilArk_Col_Max = LastColumn(TilArk)

    ' Find ud af hvilket ark der har flest rækker
    If FraArk_Rw_Max > TilArk_Rw_Max Then
        RwMax = FraArk_Rw_Max
    Else
        RwMax = TilArk_Rw_Max
    End If

    ' Find ud af hvilket ark der har flest kolonner
    If FraArk_Col_Max > TilArk_Col_Max Then
        ColMax = FraArk_Col_Max
    Else
        ColMax = TilArk_Col_Max
    End If

    'Opbyg ResultSheet
    ResultSheet.Cells(1, 1).Value = "Række" ' Columm Række is added
    For Col2 = 1 To ColMax
        If FraArk.Cells(1, Col2).Value <> "" Then
            ResultSheet.Cells(1, Col2 + 1).Value = FraArk.Cells(1, Col2).Value
        Else
            ResultSheet.Cells(1, Col2 + 1).Value = TilArk.Cells(1, Col2).Value
            ResultSheet.Cells(1, Col2 + 1).Interior.ColorIndex = 3 ' Marker celle i ResultSheet
        End If
    Next Col2
   

    'Udfør sammenligning
    TotalErr = 0
    RowErr = 0
    For Rw = 1 To RwMax
        RowErrFlag = False
       
        For Col = 1 To ColMax
            If FraArk.Cells(Rw, Col).Value <> TilArk.Cells(Rw, Col).Value Then
                TotalErr = TotalErr + 1
                FraArk.Rows(Rw).Interior.ColorIndex = 6 ' marker celle i FraArk
                FraArk.Cells(Rw, Col).Interior.ColorIndex = 3 ' marker celle i FraArk
                TilArk.Rows(Rw).Interior.ColorIndex = 6 ' marker Række i TilArk
                TilArk.Cells(Rw, Col).Interior.ColorIndex = 3 ' Marker celle i TilArk
                If Not RowErrFlag Then
                    RowErr = RowErr + 1
                    RowErrFlag = True
                    For Col2 = 1 To ColMax
                        ResultSheet.Cells((3 * RowErr), 1).Value = Rw
                        ResultSheet.Cells((3 * RowErr), Col2 + 1).Value = FraArk.Cells(Rw, Col2).Value
                        ResultSheet.Cells((3 * RowErr) + 1, Col2 + 1).Value = TilArk.Cells(Rw, Col2).Value
                    Next Col2
                End If
                ResultSheet.Cells((3 * RowErr) + 1, Col + 1).Interior.ColorIndex = 3 ' Marker celle i ResultSheet
                ResultSheet.Cells((3 * RowErr), Col + 1).Interior.ColorIndex = 3 ' Marker celle i ResultSheet
            End If
        Next Col
    Next Rw
    FraArk.Columns.AutoFit
  ' FraArk.Rows.AutoFit
    TilArk.Columns.AutoFit
    TilArk.Rows.AutoFit
    ResultSheet.Columns.AutoFit

   
    'Make Remarks
    Dim ResultLine As Long
    ResultLine = (3 * RowErr) + 3
    ResultSheet.Cells(ResultLine, 1).Value = "Antal fejl rækker"
    ResultSheet.Cells(ResultLine, 2).Value = RowErr
    ResultSheet.Cells(ResultLine + 1, 1).Value = "Antal fejl i alt"
    ResultSheet.Cells(ResultLine + 1, 2).Value = TotalErr
    MsgBox ("Failed rows: " & RowErr & vbCrLf & _
            "Total errors: " & TotalErr)
End Sub