Option Explicit

Sub tt()
      Dim sh As Object, x&, i&, ii&, t$
      Dim a()

      With CreateObject("Scripting.Dictionary"): .comparemode = 1

          For Each sh In ThisWorkbook.Worksheets
              x = x + 1
              If x = 6 Then Exit For
              a = sh.[b3].CurrentRegion.Value
              For i = 2 To UBound(a)
                  t = a(i, 2) & "|" & a(i, 3)
                  .Item(t) = .Item(t) + 1
              Next
          Next
          a = Sheets("обобщённый").[a7:e22].Value
          For i = 2 To UBound(a)
              For ii = 2 To UBound(a, 2)
                  a(i, ii) = .Item(a(i, 1) & "|" & Left(a(1, ii), 1))
              Next
          Next
          Sheets("обобщённый").[a7:e22].Value = a
      End With
End Sub