Sub test()
Dim c As Range, d As Range, e As Range
Range("B22:D2000").ClearContents
Set c = [B5]: Set d = [G5]: Set e = [B22]
Do While Cells(c.Row, 1) <> ""
For t = 0 To 4 '5 objets
For u = 0 To 4 '5 dispos
If c.Offset(0, t) = "X" And d.Offset(0, u) = "X" Then
e = Cells(4, c.Offset(0, t).Column)
e(1, 2) = Cells(c.Row, 1)
e(1, 3) = Cells(4, d.Offset(0, u).Column)
Set e = e(2, 1)
End If
Next u
Next t
Set c = c(2, 1): Set d = d(2, 1)
Loop
e.Sort key1:=[B22], order1:=xlAscending, key2:=[C22], order2:=xlAscending, key3:=[D22], order1:=xlAscending, Header:=xlYes
End Sub