Sub test()
Dim DerCol As Integer, FirstAddress As String, C As Range
Dim I As Integer, J As Integer, Suppr As String
DerCol = Range("IV2").End(xlToLeft).Column
For I = 2 To Range("IV2").End(xlToLeft).Column
If Cells(2, I) = "" Then Exit For
Set C = Range("A2:" & Chr(63 + I) & "2").Find(Cells(2, I), LookIn:=xlValues, LookAt:=xlWhole)
If C Is Nothing Then
With Range(Chr(64 + I) & "2:IV2")
Set C = .Find(Cells(2, I), LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then
FirstAddress = C.Address
Do
If C.Column > I Then
For J = 3 To Range("B" & Rows.Count).End(xlUp).Row
Cells(J, I) = Cells(J, I) & ";" & Cells(J, C.Column)
Next J
Suppr = Suppr & "," & Chr(64 + C.Column) & ":" & Chr(64 + C.Column)
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> FirstAddress
End If
End With
End If
Next I
If Suppr <> "" Then
Suppr = Right(Suppr, Len(Suppr) - 1)
MsgBox Suppr
Range(Suppr).Delete
End If
End Sub