XL 2016 Extraire des doublons sur 5 colonnes

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, c As Range
Set d = CreateObject("Scripting.Dictionary")
For Each c In [A:I].SpecialCells(xlCellTypeConstants, 2) 'colonnes à adapter éventuellement
    If IsNumeric(CStr(c(1, 2))) Then d(c.Value) = d(c.Value) + c(1, 2)
Next
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [M4] '1ère cellule de destination, à adapter
    If d.Count Then
        .Resize(d.Count) = Application.Transpose(d.keys) 'Transpose est limitée à 65536 lignes
        .Offset(, 1).Resize(d.Count) = Application.Transpose(d.items)
        .Resize(d.Count, 2).Sort .Cells(1), xlAscending, Header:=xlNo 'tri alphabétique
    End If
    .Offset(d.Count).Resize(Rows.Count - d.Count - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
Application.EnableEvents = True 'réactive les évènements
End Sub