Indicare numero con presenza decrescente

---

Option Explicit
Sub Macro_col_creatore()
Dim cont As String
Dim i As Long
Dim cBB As Long
cBB = 54
Dim Nriga As Long

For i = 39 To 50
Range(Cells(3, i), Cells(17, i)).Select
Selection.Copy
Cells(3, cBB).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range(Cells(2, cBB), Cells(17, cBB)).RemoveDuplicates Columns:=1, Header:= _
xlYes

Nriga = Cells(Rows.Count, cBB).End(xlUp).Row + 1 ''dimenticato
Cells(3, cBB + 1).Select
cont = "=COUNTIF(R3C" & i & ":R17C" & i & ",RC[-1])"
ActiveCell.FormulaR1C1 = cont
Selection.AutoFill Destination:=Range(Cells(3, cBB + 1), Cells(Nriga, cBB + 1)), Type:=xlFillDefault
Range(Cells(3, cBB), Cells(Nriga, cBB + 1)).Select
ActiveWorkbook.Worksheets("Helper").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Helper").Sort.SortFields.Add Key:=Cells(3, cBB + 1), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Helper").Sort
.SetRange Range(Cells(2, cBB), Cells(Nriga, cBB + 1))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("Helper").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Helper").Sort.SortFields.Add Key:=Range(Cells(3, cBB + 1), Cells(Nriga, cBB + 1)) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Helper").Sort
.SetRange Range(Cells(2, cBB), Cells(Nriga, cBB + 1))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range(Cells(8, cBB), Cells(Nriga, cBB + 1)).ClearContents
cBB = cBB + 2
Next i
End Sub

---