Sub sup_doublons()
Dim i As Long, j As Long, c As Long, vCalc As String
Dim oDat(), UB1 As Long, UB2 As Long, oPropre(), vDat
vCalc = Application.Calculation
oDat = Me.[A1].CurrentRegion.Value
oDat = Application.Transpose(oDat)
UB1 = UBound(oDat, 1): UB2 = UBound(oDat, 2)
ReDim oPropre(1 To UB1, 1 To UB2)
For i = 1 To UB1: oPropre(i, 1) = oDat(i, 1): Next i
c = 1
For i = 1 To UB2
vDat = oDat(1, i)
For j = 1 To c
If oPropre(1, j) = vDat Then Exit For
Next j
If j > c Then
c = j
For j = 1 To UB1
oPropre(j, c) = oDat(j, i)
Next j
End If
Next i
Erase oDat
ReDim Preserve oPropre(1 To UB1, 1 To c)
oPropre = Application.Transpose(oPropre)
vCalc = Application.Calculation
Application.Calculation = xlCalculationManual
Sheets.Add after:=Me
Application.ScreenUpdating = False
With ActiveSheet
.Range(.Cells(1, 1), .Cells(c, UB1)).Value = oPropre
End With
Erase oPropre
Application.Calculation = vCalc
Application.ScreenUpdating = True
End Sub