Ciao
ricordati che è sempre meglio allegare un file per "vederne" la struttura.
Ciò premesso, ammesso che i tuoi numeri si trovino nell'intervallo A1:D10, prova con questa macro da associare ad un pulsante (non ActiveX).
Option Explicit
Sub prova()
Dim a As Range, b As Range, c As Range, d As Range
Dim cn1 As Range, cn2 As Range, cn3 As Range, cn4 As Range
Dim n1 As Integer, n2 As Integer, n3 As Integer, n4 As Integer
Dim r As Long, i As Long, j As Long, k As Long, ur As Long
Dim num As Integer, vt As Integer
Set cn1 = Range("A1:A10")
Set cn2 = Range("B1:B10")
Set cn3 = Range("C1:C10")
Set cn4 = Range("D1:D10")
Range("G1:K100").ClearContents
For Each a In cn1
n1 = a
For Each b In cn2
n2 = b
For Each c In cn3
n3 = c
For Each d In cn4
n4 = d
'numero in tutte le colonne
If n1 = n2 And n1 = n3 And n1 = n4 Then
Cells(1, 7) = n1
GoTo NumRipet
End If
Next
Next
Next
Next
NumRipet:
'scrive tutte le colonne in colonna J
r = 0
For Each a In cn1
r = r + 1
Cells(r, 10) = a.Value
Next
For Each b In cn2
r = r + 1
Cells(r, 10) = b.Value
Next
For Each c In cn3
r = r + 1
Cells(r, 10) = c.Value
Next
For Each d In cn4
r = r + 1
Cells(r, 10) = d.Value
Next
'elimina doppioni
Columns("J:J").RemoveDuplicates Columns:=1, Header:=xlNo
ur = Cells(Rows.Count, 10).End(xlUp).Row
'numero ripetuto e numero ripetizioni
For i = 1 To ur
num = Cells(i, 10).Value
For k = 1 To 10
For j = 1 To 4
If num = Cells(k, j).Value Then
vt = vt + 1
End If
Next j
Next k
Cells(i, 11) = vt
vt = 0
Next i
Set cn1 = Nothing
Set cn2 = Nothing
Set cn3 = Nothing
Set cn4 = Nothing
End Sub
Fai sapere. Ciao,
Mario