Dédoublonner en compléter les cellules de plusieurs lignes

Option Explicit
Option Private Module

Public Sub Dédoublonner()
Dim rng As Range
Dim cel As Range
Dim val As Variant
Dim col As Long
Dim p°L As Long
Dim d°L As Long
Dim ctr As Long

  Set rng = ActiveSheet.Range("A1").CurrentRegion
  Set cel = rng.Cells(2, 1)
  rng.Sort Key1:=cel, Order1:=xlAscending, Header:=xlYes
  
  Do While Not IsEmpty(cel.Value)
    val = cel.Value
    For col = 1 To rng.Columns.Count - 1
      ctr = 0
      val = Null
      Do While cel.Offset(ctr).Value = cel.Value And cel.Offset(ctr).Row <= rng.Rows.Count
        If cel.Offset(ctr, col).Formula <> "" Then
          val = cel.Offset(ctr, col).Value
          Exit Do
        End If
        ctr = ctr + 1
      Loop
      ctr = 0
      If Not IsEmpty(val) Then
        Do While cel.Offset(ctr).Value = cel.Value And cel.Offset(ctr).Row <= rng.Rows.Count
          cel.Offset(ctr, col).Value = val
          ctr = ctr + 1
        Loop
      End If
    Next
    Set cel = cel.Offset(ctr)
  Loop
  
End Sub