Sub Vergleichen()
Dim Datei1 As String, Datei2 As String
Dim wb1 As Object, wb2 As Object
Dim lastrow As Long, i, j
Dim writerow As Long, erg As Boolean
Datei1 = Application.GetOpenFilename("Excel-Dateien (*.xls*), *.xls*", , "Bitte erste Datei zum Vergleichen auswählen")
If Datei1 = "Falsch" Then Exit Sub
Datei2 = Application.GetOpenFilename("Excel-Dateien (*.xls*), *.xls*", , "Bitte zweite Datei zum Vergleichen auswählen")
If Datei2 = "Falsch" Then Exit Sub
Application.ScreenUpdating = False
Set wb1 = Workbooks.Open(Datei1)
Set wb2 = Workbooks.Open(Datei2)
For i = 1 To 3
lastrow = WorksheetSub.Max(wb1.ActiveSheet.Cells(Rows.Count, i).End(xlUp).Row)
lastrow = WorksheetSub.Max(wb2.ActiveSheet.Cells(Rows.Count, i).End(xlUp).Row)
Next i
Workbooks.Add
With ActiveSheet
.Cells(1, 1) = "Ergebnis Dateivergleich"
.Cells(2, 1) = "Datei 1: " & Datei1
.Cells(3, 1) = "Datei 2: " & Datei2
writerow = 4
For i = 1 To lastrow
For j = 1 To 3
If wb1.ActiveSheet.Cells(i, j) <> wb2.ActiveSheet.Cells(i, j) Then
erg = True
ActiveSheet.Cells(writerow, 1) = "Abweichung in Zeile " & i & ", Spalte " & j
End If
Next j
Next i
If Not erg Then .Cells(4, 1) = "keine Abweichung gefunden"
End With
Workbooks(wb1.Name).Close False
Workbooks(wb2.Name).Close False
Application.ScreenUpdating = True
MsgBox "Vergleichen beendet, Ergebnis in neuer Datei", vbInformation, "Ende"
End Sub