Sub DDD()
Dim nCol As Byte, n As Byte
Dim i&, j&
Dim a()
a = Sheets("bdd").[a1].CurrentRegion.Value
nCol = UBound(a, 2)
ReDim d(1 To nCol - 1)
For i = 1 To nCol - 1
Set d(i) = CreateObject("scripting.dictionary")
Next i
For i = LBound(a) To UBound(a)
For j = LBound(a, 2) To UBound(a, 2) - 1
d(j)(a(i, j)) = ""
Next j, i
With Sheets("DDD")
.Cells.Clear
n = 1
For j = 1 To nCol - 1
.Cells(1, n).Resize(d(j).Count).Value = Application.Transpose(d(j).Keys)
n = n + 2
Next j
End With
End Sub