Option Explicit
Sub tradem()
Dim Collec As New Collection
Dim Cellule As Range
Dim Nomfeuille1 As String
Dim Col As String
Dim flag As Boolean
'parametre
Nomfeuille1 = "Feuil1"
Col = "A"
With Sheets(Nomfeuille1)
For Each Cellule In .Range(Col & "7:" & Col & .Range(Col & .Rows.Count).End(xlUp).Row)
On Error Resume Next
Collec.Add CStr(Cellule), CStr(Cellule)
Next Cellule
On Error GoTo 0
Col = "B"
For Each Cellule In .Range(Col & "7:" & Col & .Range(Col & .Rows.Count).End(xlUp).Row)
On Error GoTo erreur
flag = False
Collec.Add CStr(Cellule), CStr(Cellule)
If flag = False Then Cellule.Offset(0, 1) = Cellule
Next Cellule
On Error GoTo 0
End With
Exit Sub
erreur:
flag = True
Resume Next
End Sub