Couper-coller ligne sur une autre page en fonction d'une cellule

Bonjour à tous,

Après avoir parcouru le forum et essayé de recopier et d'adapter un code simple, me voici bloqué.

Je m'explique :

Dans l'exemple ci-joint, j'ai 2 onglets : ROUGE ou BLEU. Chaque onglet est identique avec des noms, prénoms, âges, ...

Je voudrais que chaque personne soit triées en fonction de sa couleur (Rouge ou bleu donc) et que toutes les informations correspondent à cette personne soit coupé/collé dans l'onglet correspondant.

Jusque là, ça va, sauf que l'une des informations s'efface durant le trajet ^^

Si on pouvait rajouter le lieu où la ligne à atterrie ça serait aussi tip top

Par ailleurs, je voudrais pouvoir conserver la liste de choix qui me permette de choisir Rouge ou Bleu... Or, avec le mouvement, elle disparaît.

Autre chose, je voudrais qu'une fois arrivé à destination, le tableau refasse un tri par ordre alphabétique.

Est-ce que cela est possible ?

PS. Peut-être que je vais en demander un peu trop mais serait-il possible qu'un vérification s'effectue avant de fermer le document pour voir que tout est bien à sa place ?

En vous remerciant par avance

Juju

Je viens de trouver ce code mais la ligne qui s'est coupée/collée reste vierge dans mon premier tableau et une erreur apparaît.

Dim StopProcess As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Crit As String, NoDossier As String
Dim Lig As Integer, NewLig As Integer
Dim f1 As Worksheet, f2 As Worksheet
Dim C As Object
Dim Max As Long

'La variable StopProcess permet d'empécher l'excution en boucle du code
If StopProcess = True Then StopProcess = False: Exit Sub

Set f1 = Sheets("BLEU") 
Set f2 = Sheets("ROUGE") 

If Selection.Count = 1 Then 'Si une seule cellule est sélectionnée alors :
    If Not Intersect(Target, f1.Range("D:D")) Is Nothing Then 'Si la cellule séletionnée se trouve dans la colonne D de f1 alors :
        Crit = UCase(Target) 'La varibale Crit représente le contenue de la cellule sélectionnée en majuscule
        If Crit = "BLEU" Then 'Si la varibale Crit = BLEU alors :
            StopProcess = True 'La variable StopProcess passe à l'état VRAI
            Max = f2.Range("A" & Rows.Count).End(xlUp).Row + 1
            Lig = Target.Row 'La varibale Lig prend pour valeur le numéro de la ligne sélectionnée
            f1.Range("A" & Lig & ":Y" & Lig).Cut f2.Range("A" & Max) 'La plage contenue entre les colonnes A et Y sur la ligne représenté par Lig est coupée
            StopProcess = True
            f1.Range("A" & Lig & ":Y" & Lig).Delete Shift:=xlUp 'La plage précedement définie sur f1 est effacée avec un décalage des autres cellules vers le haut
            Exit Sub
        End If 'Fin du si Crit = En veille

      End If

End Sub

Après la poursuite de mes recherches, j'ai trouvé un autre code qui fonctionne mais qui me fait apparaître une erreur "Erreur 424 Objet requis"

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, [Q3:Q250]) Is Nothing Then 'plage à adapter
    If Target.Count > 1 Then Exit Sub 'si on modifie plusieurs cellules simultanément
    If UCase(Target) = "BLEUE" Then
        nouvlig = Sheets("BLEU").Cells(Rows.Count, 1).End(xlUp).Row + 1 
        Cells(Target.Row, 1).Resize(1, 26).Copy
        Sheets("BLEU").Cells(nouvlig, 1).Resize(1, 26).PasteSpecial
        Application.EnableEvents = False 'désactiver les événements
        Cells(Target.Row, 1).EntireRow.Delete
        Application.EnableEvents = True
    End If
  If UCase(Target) = "ROUGE" Then
        nouvlig = Sheets("ROUGE").Cells(Rows.Count, 1).End(xlUp).Row + 1 
        Cells(Target.Row, 1).Resize(1, 26).Copy
        Sheets("ROUGE").Cells(nouvlig, 1).Resize(1, 26).PasteSpecial
        Application.EnableEvents = False 'désactiver les événements
        Cells(Target.Row, 1).EntireRow.Delete
        Application.EnableEvents = True
    End If

End If
End Sub

Quelqu'un saurait me dire ce qui cloche ?

Merci beaucoup

Juju