Sub CopieURL()
Dim S As Worksheet
Dim nbLig&
Dim R As Range
Dim T()
Dim i&
Dim var
Set S = ActiveSheet
nbLig& = S.[a65536].End(xlUp).Row
S.Columns(1).Insert
Set R = S.Range("a1:a" & nbLig& & "")
ReDim T(1 To nbLig&, 1 To 1)
For i& = 1 To nbLig&
T(i&, 1) = i&
Next i&
R = T
Set R = S.Range("a1:c" & nbLig& & "")
R.Sort Key1:=[b1], Order1:=xlAscending, _
Key2:=[c1], Order2:=xlAscending, Header:=xlNo
var = R
For i& = 1 To nbLig& - 1
If var(i&, 2) = var(i& + 1, 2) Then
If var(i&, 3) <> "" Then
var(i& + 1, 3) = var(i&, 3)
End If
End If
Next i&
R = var
R.Sort Key1:=[a1], Order1:=xlAscending, Header:=xlNo
S.Columns(1).Delete
End Sub