Tri entre 2 lignes avec espacement différents

Bonjour à toutes et à tous,

Alors voilà j'ai besoin d'effectuer un tri entre 2 lignes, en colonne "B" je vais avoir un libellé d'article ensuite des cellules vides en "B" mais en "H" et "J" les déclinaisons de mon article.
je vous joins un exemple de mon tableau.

j'ai utilisé l'enregistrement de macro mais ce n'est pas trsè convaincant, j'ai dû merdé quelque part...

Si vous avez des idées je suis hyper preneur cela fait quelques jours que je cherche en vain...

Par avance, merci.

Maxhoo

Sub Macro2()
'macro test tri
Dim nblignes
Dim VILLE[https://img-19.ccm2.net/hL9rwYL6d4-0phjHRi0AQgZbphQ=/5d3575def3484bec85e10eb40dc78f38/ccm-ugc/Capture_decran_2020-08-19_a_14.32.32.png [Image:https://img-19.ccm2.net/pzwqkY4SaAQq8aBwPFlw303XBl4=/440x/5d3575def3484bec85e10eb40dc78f38/ccm-ugc/Capture_decran_2020-08-19_a_14.32.32.png|440px|]|fancy]
Dim VILLE_CONTR

Sheets("Ajout ville catalogue Tactill").Activate
VILLE = Range("B3").Value
VILLE_CONTR = Range("B2").Value

Sheets("catalogue").Activate
DernièreLigne = Range("O3").SpecialCells(xlCellTypeLastCell).Row

For y = 1 To DernièreLigne
If Cells(y, 2) <> "" And nblignes = 0 Then
nblignes = nblignes + 1
Else
If Cells(y, 2) = "" And nblignes <> 0 Then
nblignes = nblignes + 1
Else
If Cells(y, 2) <> "" And nblignes <> 0 Then
Rows(y & ":" & y + nblignes).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range( _
        "B2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
        :=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
        nblignes = 0

    ActiveWorkbook.Worksheets("catalogue").Sort.SortFields.Add2 Key:=Range( _
        "H" & y - nblignes & ":H" & y), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("catalogue").Sort.SortFields.Add2 Key:=Range( _
        "J" & y - nblignes & ":J" & y), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("catalogue").Sort.SortFields.Add2 Key:=Range( _
        "L" & y - nblignes & ":L" & y), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("catalogue").Sort
        .SetRange Range("A"&y- nblignes & "Q" & y)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End If
End If
End If
Next y
End Sub