Relier deux codes

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

1)j'ai un code qui est le lancement des passes dans le tunnel qui fonctionne actuellement très bien
voila l'image qui illustre ce qui est fait avec cette macro
Pièce jointe 214821

voila la macro de cette partie :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
'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) Ce second code fonctionne aussi sauf que c'est pas exactement ce que je voulais
voila l'image et la macro
Pièce jointe 214822

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
'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) Si vous pouvez m'aidez à relier les deux parties et améliorer le fonctionnement de la 2éme partie :

je veux en faite que l'arriver de mes passe dans la colonne AE engendre le déclenchement de la deuxiè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'à 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 bloqué sur ça depuis la semaine dernière:(

merci