Option Explicit
Sub Dummy_Aufruf()
Dim wks As Excel.Worksheet
If WksMatch(ActiveSheet, ActiveWorkbook, wks) Then
ActiveSheet.Delete
End If
End Sub
Function WksMatch(Optional ByVal Source As Excel.Worksheet, Optional ByVal CompareWith As Excel.Workbook, Optional ByRef Match As Excel.Worksheet) As Boolean
If Source Is Nothing Then Set Source = ActiveSheet
If CompareWith Is Nothing Then Set CompareWith = ActiveWorkbook
Dim wks As Excel.Worksheet
Dim i As Long
For Each wks In CompareWith.Worksheets
If Not wks Is Source Then
If WksCompare(Source, wks, 1) Then
Source.Rows(5).Copy wks.Cells(wks.Rows.Count, "A").End(xlUp).Offset(1)
Set Match = wks
WksMatch = True
Exit Function
End If
End If
Next
End Function
Private Function WksCompare(ByVal Worksheet1 As Excel.Worksheet, ByVal Worksheet2 As Excel.Worksheet, ByVal Row As Long) As Boolean
Dim c As Variant
c = Array(0, Worksheet1.Cells(Row, Worksheet1.Columns.Count).End(xlToLeft).Column, _
Worksheet2.Cells(Row, Worksheet2.Columns.Count).End(xlToLeft).Column)
c(0) = WorksheetFunction.Max(c(1), c(2))
If c(1) <> c(2) Then Exit Function
Dim i As Long
For i = 1 To c(0)
If Worksheet1.Cells(Row, c(1)).Value <> Worksheet2.Cells(Row, c(2)).Value Then
Exit Function
End If
Next
WksCompare = True
End Function