'Option Base 1

Private Sub UniqVal(ByVal uniq As Range, ParamArray rNotUniq())

'uniq - ячейка с которой начнется вывод уникальных значений
'rNotUniq - Диапазоны с которых берутся значения

Dim x, y, t$
Dim UniqArray
Dim UniqCollection As New Collection
On Error Resume Next

With UniqCollection
      For Each x In rNotUniq
      UniqArray = x.Value
          For Each y In UniqArray
          t = Trim(y)
              If Len(t) > 0 Then
                  .Add t, t
              End If
          Next
      Next
        
ReDim UniqArray(.Count)
          For x = 0 To .Count
              UniqArray(x) = .Item(x)
          Next
End With

uniq.Resize(UBound(UniqArray) + 1).Value = WorksheetFunction.Transpose(UniqArray)
End Sub