Die Beispieldatei falls notwendig ist hier zu finden:
https://www.herber.de/bbs/user/140326.xlsx
dim dicSpalten as object
dim x
set dicSpalten = CreateObject("Scripting.Dictionary")
for each x in Columns(2).SpecialCells(xlcelltypeconstants, 2)
dicSpalten(x) = 0
Next
Range("E1").Resize(1, dicSpalten.Count).Value = dicSpalten.Keys
oder wenns der Excelweg sein soll
Range("B:B").SpecialCells(xlcelltypeconstants, 2).Copy
Range("E3").PasteSpecial xlpastevalues
Selection.RemoveDuplicates 1, xlno
Range("E3").CurrentRegion.Copy
Range("E1").PasteSpecial xlpastevalues, Transpose:=True
Range("E3").CurrentRegion.ClearContents
Gruß Daniel