Fusion de lignes si doublon de certaines colonnes

Sub Macro1()
Dim o As Object 'déclare la variable o (Onglet)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim d As Object 'déclare la variable d (Dictionnaire)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim tmp As Variant 'déclare la variable tmp (tableau TeMPoraire)
Dim i As Integer 'déclare la variable i (Incrément)
Dim nb As String 'déclare la variable nb (Numéro du Brevet)

Set o = Sheets("Classeur test intellixir") 'définit l'onglet o
dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Row 'de'finit la dernière ligne éditée dl de la colonne 1 (=A)
Set pl = o.Range("A2:A" & dl) 'définit la plage pl
Set d = CreateObject("Scripting.Dictionary") 'définit le dictionnaire d
For Each cel In pl 'boucle sur toutes les cellules éditées cel de la plage pl
    d(cel.Value) = "" 'alimente le dictionnaire
Next cel 'prochaine cellule de la boucle
tmp = d.keys 'récupère dans le tableau temporaire tmp la liste des éléments uniques de la plage pl (sans doublon)
For i = LBound(tmp) To UBound(tmp) 'boucle 1 : sur tous les éléments uniques du tableau tmp
    o.Range("A1").AutoFilter Field:=1, Criteria1:=tmp(i) 'filtre les données dans la colonne 1 (=A) par rapport à l'élément unique tmp(i)
    If pl.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then 'condition : si le nombre de cellules visibles de la plage pl  est supérieur à 1 (= plusieurs numéros de brevet)
        For Each cel In pl.Offset(0, 3).SpecialCells(xlVisible) 'boucle 2 : sur toutes les cellules visibles de la plage pl décalée de 3 colonne à droite (=colonne D)
            nb = IIf(nb = "", cel.Value, nb & "; " & cel.Value) 'définit la variable nb (en ajoutant au fur et à mesure le numéro de brevet)
        Next cel 'prochaine cellule de la boucle 2
        pl.SpecialCells(xlCellTypeVisible).Cells(1, 4).Value = nb 'renvoie le numéro de brevet dans la première ligne, colonne 4 de la plage  des cellules visibles
        pl.SpecialCells(xlCellTypeVisible).Cells(2, 1).Resize(pl.SpecialCells(xlCellTypeVisible).Rows.Count - 1, 1).EntireRow.Delete 'supprime les autre lignes en dessous
    End If 'fin de l acondition
    o.Range("A1").AutoFilter 'supprime le filtre automatique
    nb = "" 'remet à zéro le numéro de brevet
Next i 'prochain cellule de la boucle 1
End Sub

Sub pinou95()
Dim WksA As Worksheet, WksB As Worksheet, DerLig As Long, TabloA, i As Long

Set WksA = Worksheets("Classeur test intellixir") ' Nom de la feuille ou se trouvent les données
Set WksB = Worksheets("Feuil1") ' Nom de la feuille ou les données seront copiées et traitées
   

DerLig = WksA.Range("A" & Rows.Count).End(xlUp).Row ' recherche du N° de la dernière ligne
TabloA = WksA.Range("A1:G" & DerLig)  'copie des données dans un tableau

Application.ScreenUpdating = False

WksB.Range("A1").Resize(UBound(TabloA, 1), 7) = TabloA 'copie du tableau dans la feuille de travail
With WksB
.Range("A1:G" & DerLig).Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess 'on trie les données dans l'ordre
                                                                                    'des N° de priorité
For i = DerLig To 2 Step -1 ' de la dernière à la 2ème ligne
    If .Cells(i, 3) = .Cells(i - 1, 3) Then 'si N° de priorité est ègal celui de la ligne précédente
        .Cells(i - 1, 4) = .Cells(i - 1, 4) & " ; " & .Cells(i, 4) 'copie le N° brevet dans la ligne du dessus
        .Rows(i).Delete Shift:=xlUp 'suppression de la ligne courante
    End If
Next

.Columns("A:G").AutoFit
End With

Application.ScreenUpdating = True
End Sub