Déplacement de valeur dans des cellules

Thev regarde stp si tu peux m'aider a faire ca

Bonjour les amis svp j'ai encore besoin de votre aide svp sur le méme projet 8O:(

1)j'ai en faite fait le code de la premiére partis qui est le lancement des passes dans le tunel qui fonctionne actuellement trés bien

voila l'image qui illustre ce qui est fait avec cette macro

voila la macro de cette parti:

'boucle qui gére le tableau O:T et la colonne X et les colonne Z:AE
Sub Plaque5_Cliquer()
    Dim UniteLavage As Long
    Dim d As Object
    Dim rep As String
    Dim i As Integer, j As Integer, c As Variant
    Dim Rng1, Rng2 As Range
    Dim N_Boucle As Integer, Nbre_Total_Boucl As Integer
    Dim Arret As Boolean
    Dim DerLig As Long
    '--- initialisation
    If [B1] = "" Then MsgBox "Insérer une valeur dans B1", 16: Exit Sub
    If [B4] = "" Then MsgBox "Insérer une valeur dans B4", 16: Exit Sub
    'On enregistre la variable UniteLavage
    UniteLavage = [B1]
    Arret = False
    N_Boucle = 0
    Nbre_Total_Boucl = Columns(1).Find("*", , , , , xlPrevious).Row - 6 '--- nb plats en colonne A
    Debug.Print "Nbre_Total_Boucl: "; Nbre_Total_Boucl
    Sheets("Interface").Activate
    '---
    Do Until Range("B3") = Range("B4")      '--- Tonnage tunnel = tonnage semaine
        N_Boucle = N_Boucle + 1
        Debug.Print "N_Boucle: "; N_Boucle
        EntreePasses N_Boucle, Nbre_Total_Boucl
        Application.Wait Time + TimeSerial(0, 0, 2) 'attends 10 sec
        DoEvents
        If [T8] = "" Then
            '--- rien, continuer
        Else
            Set Rng1 = Columns(24).Cells.Find(Range("T8"))  '--- Colonne 24 = X:X
            Debug.Print "VRng1.Address: "; Rng1.Address
            If Rng1 Is Nothing Then
                MsgBox Range("A7").Offset(N_Boucle, 0) & " non trouvé en colonne X"
            Else
                If Rng1.Offset(1, 2) <> "" Then
                    MsgBox "Attention tous les emplacements sont occupés", vbOKOnly + vbExclamation, "Blocage"
                    Exit Sub
                Else
                    For i = 2 To 6        '--- décalage vers la gauche
                        Rng1.Offset(1, i) = Rng1.Offset(1, i + 1)
                    Next i
                    Rng1.Offset(1, 7) = [B1]
                    Rng1.Offset(1, 0) = Rng1.Offset(1, 0) + [B1]
                    [B3] = [B3] + [B1]
                    [T7] = ""
                    [T8] = ""
                    If Rng1.Offset(1, 2) <> "" Then
                        MsgBox "Tous les emplacements de " & Rng1 & " sont occupés," & vbCrLf & _
                                "mais pourra continuer si le plat suivant" & vbCrLf & _
                                "n'est le même que " & Rng1, _
                                vbOKOnly + vbExclamation, "Attention"
                    End If
                End If
            End If
        End If
    Loop
    MsgBox "Le tonnage tunnel a atteint le tonnage semaine.", , "Pour info"
End Sub

Sub EntreePasses(k As Integer, N As Integer)
    Dim i As Long, sPlat As String
    '--- décale les cellules vers la droite
    For i = 20 To 16 Step -1
        Cells(7, i) = Cells(7, i - 1)
        Cells(8, i) = Cells(8, i - 1)
    Next i
    If k Mod N = 0 Then
        k = N
    Else
        k = k Mod N
    End If
    sPlat = Cells(k + 6, 1)      '--- plat en ligne k + 6
    If sPlat = "" Then
        Cells(7, 15) = ""
        Cells(8, 15) = ""
    Else
        Cells(7, 15) = [B1]      '--- Unité lavage
        Cells(8, 15) = sPlat
    End If
End Sub

2) la deuxiéme parti fonctionne aussi sauf que c'est pas exactement ce que je voulais

voila l'image et la macro

'gestion des choix aléatoire des familles d'article dans le narlivté et affectation au séchoir
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DerniereLigne, CptLigne, CptValeur As Integer
    CptValeur = 1

Recommence_la_boucle:
    If Mid(Target.Address, 2, 2) = "AE" Then
        If Target.Value <> "" Then
Recommence_la_boucl:
            If Application.WorksheetFunction.CountIf(Columns("AN:AN"), Target.Offset(-1).Value) > 0 Then

                Valeur = Int(Application.WorksheetFunction.CountIf(Columns("AN:AN"), Target.Offset(-1).Value) * Rnd) + 1
                DerniereLigne = Range("AN" & Rows.Count).End(xlUp).Row
                For CptLigne = 2 To DerniereLigne

                    If Range("AN" & CptLigne).Value = Target.Offset(-1).Value Then
                        If CptValeur = Valeur Then
                        If Range("AH" & CptLigne).Value - Range("AJ" & CptLigne).Value < 0 Then GoTo Recommence_la_boucl
                            Range("AQ" & CptLigne).Value = Range("AH" & CptLigne).Value - Range("AJ" & CptLigne).Value

                            Sechoir = Range("AL" & CptLigne).Value
                            UniteLavage = Range("AJ" & CptLigne).Value
                            Set celluletrouvee = Range("AU:AU").Find(Sechoir, lookat:=xlWhole)

                            If celluletrouvee Is Nothing Then
                                MsgBox ("Séchoir introuvable")
                            Else

                                  Range("AU" & celluletrouvee.Row + 1).Value = UniteLavage

                            End If
                             GoTo Recommence_la_boucle
                            'GoTo FinJob
                        Else
                            CptValeur = CptValeur + 1
                        End If
                    End If
                Next CptLigne
            Else
                MsgBox ("Pas de correspondance dans le tableau AG:AS")
            End If
        End If
    End If
FinJob:
End Sub

3) ce que je veux moi si vous pouvez m'aidez svp c'est de relié les deux partis et d'améliorer le fonctionnement de la 2éme partis:

je veux en faite que l'arriver de mes passe dans la colonne AE engendre le déclanchement de la deusiéme partis , ce qui est fait maintenant mais je veux que au moment ou les passes son envoyer au séchoirs que ma colonne AE dois ce vider pour recevoir toutes les passe de la colonne AD et ainsi de suite jusqu'a que je fini toute les passe

aprés une seconde les séchoirs se vide pour recevoir les nouvelles passes

Aidez moi svp je suis bloquer sur ca depuis la semaine dernière:(

merci

merci