Gather similar data in two tables

Maybe :

Sub Test()
  Dim coll As New Collection, arr(), i As Long, j As Long, strKey As String
  With Sheets("Sheet1")
    i = Application.Max(.Cells(.Rows.Count, "A").End(xlUp).Row, .Cells(.Rows.Count, "F").End(xlUp).Row)
    arr = .Range("A3:J" & i).Value
  End With
  For i = 1 To UBound(arr, 1)
      For j = 1 To UBound(arr, 2) Step 5
          If Len(arr(i, j)) Then
             On Error Resume Next
                coll.Add key:=arr(i, j), Item:=New Collection
             On Error GoTo 0
             coll(arr(i, j)).Add Empty
          End If
      Next j
  Next i
  For i = 1 To UBound(arr, 1)
      For j = 1 To UBound(arr, 2) Step 5
          If Len(arr(i, j)) Then
             arr(i, j + 4) = IIf(coll(arr(i, j)).Count = 2, 1, "")
          End If
      Next j
  Next i
  With Sheets("Output")
    .Cells.Clear
    Sheets("Sheet1").Rows(2).Copy .Rows(2)
    With .Range("A3").Resize(UBound(arr, 1), UBound(arr, 2))
      .Value = arr
      .Columns("A:E").Sort key1:=.Columns("E"), order1:=xlAscending, key2:=.Columns("A"), order2:=xlAscending, header:=xlNo
      .Columns("F:J").Sort key1:=.Columns("J"), order1:=xlAscending, key2:=.Columns("F"), order2:=xlAscending, header:=xlNo
      Intersect(.Areas(1), .Columns("E").SpecialCells(xlCellTypeConstants).EntireRow).Interior.Color = 16777164
      .Columns("E").Clear
      .Columns("J").Clear
    End With
  End With
End Sub