Option Explicit
Sub test()
Dim a, b(), i As Long, j As Long, n As Long, dico As Object, ws As Worksheet
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
'attention a la 1ere dimension
ReDim b(1 To 100, 1 To 3)
n = 1: b(n, 2) = "signal A": b(n, 3) = "signal V"
For Each ws In ActiveWindow.SelectedSheets
With ws.Range("a2").CurrentRegion
a = .Value
For i = 2 To UBound(a, 1)
For j = 1 To 5
If Not IsEmpty(a(i, j)) Then
If Not dico.exists(a(i, j)) Then
n = n + 1
b(n, 1) = a(i, j)
dico(a(i, j)) = n
End If
b(dico(a(i, j)), 2) = b(dico(a(i, j)), 2) + 1
End If
Next
For j = 6 To 8
If Not IsEmpty(a(i, j)) Then
If Not dico.exists(a(i, j)) Then
n = n + 1
b(n, 1) = a(i, j)
dico(a(i, j)) = n
End If
b(dico(a(i, j)), 3) = b(dico(a(i, j)), 3) + 1
End If
Next
Next
End With
Next
Application.ScreenUpdating = False
With Sheets.Add().Cells(1).Resize(n, 3)
.Value = b
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
With .Rows(1)
.BorderAround Weight:=xlThin
.HorizontalAlignment = xlCenter
End With
End With
Set dico = Nothing
Application.ScreenUpdating = True
End Sub