Sub tableau()
Dim tboall() As Variant
Dim tbosub() As Variant
Worksheets(1).Select
tboall = Range("B2:F20").SpecialCells(xlCellTypeVisible)
ReDim Preserve tbosub(1)
For I = 1 To UBound(tboall, 1)
For J = 1 To UBound(tbosub)
If tboall(I, 1) = tbosub(J) Then blnExiste = True
Next J
If blnExiste = False Then
If tbosub(1) <> "" Then ReDim Preserve tbosub(UBound(tbosub) + 1)
tbosub(UBound(tbosub)) = tboall(I, 1)
End If
blnExiste = False
Next I
For I = 1 To UBound(tbosub)
Cells(I + 20, 7) = tbosub(I)
Next I
End Sub