Déplacement de plusieurs cellules suivant condition

Bonjour,

Je souhaite trier les cellules en fonction de l'identifiant en rouge

Surement par une fonction dictionnaire

Si vous avez un début de code se serait sympa

Voir pièce jointe

Merci pour votre aide

Bonjour,

Un essai :

PS, je n'ai considéré que tu n'avais que 6 tableaux, si tu en as plus, faudra adapter (LIG et COL)

Sub tri_id()
Dim Lig As Integer, Col As Integer
Dim LesId As Object
Dim Tmp
Set LesId = CreateObject("Scripting.Dictionary")
For Lig = 3 To 37 Step 17
    For Col = 2 To 11 Step 9
        LesId(Sheets("AVANT").Cells(Lig, Col).Value) = Sheets("AVANT").Cells(Lig, Col).Resize(16, 7).Address
    Next Col
Next Lig
Tmp = LesId.Keys
Call tri(Tmp, LBound(Tmp), UBound(Tmp))
Lig = 3
For i = LBound(Tmp) To UBound(Tmp)
    Sheets("AVANT").Range(LesId.Item(Tmp(i))).Copy Sheets("APRES").Cells(Lig, 2)
    Lig = Lig + 17
Next i
End Sub

Sub tri(a, gauc, droi) ' Quick sort de JBoisgontier
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
       Tmp = a(g): a(g) = a(d): a(d) = Tmp
       g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call tri(a, g, droi)
  If gauc < d Then Call tri(a, gauc, d)
End Sub

Bon courage

Un grand merci 8)

Tout est parfait, a moi le week end de Pâques

Encore Merci