Macro VBA

J'ai besoin de votre aide svp pour modifier ma macro que monsieur Jpbt84 (membre excel pratique ) ma écrit

les amélioration que je veux effectuer a ma macro c'est pour la parti affectation de la valeur 53 aux séchoirs (colonne AU ) je veux svp que au moment ou je pointe dans ma macro sur l'une chaine de caractére placer dans la colonne AN que je vais la chercher dans la colonne AE pour prendre la valeur de la cellules qui est juste en dessous et c'est cette valeur la que je veux affecter au séchoir qui va avec dans la colonne AU .

je donne un exemple :

par exemple quand je tourne ma boucle aléatoir , si par exemple en pointe sur la ligne 13 en trouve Plat5 dans la colonne AN a ce moment la il faut partir chercher Plat5 dans la colonne AE ( en vois qu'il est placer dans la cellule AE10) et on prend la valeur de la cellules qui est juste en dessous (cellule AE11=53) et on met 53 dans la colonne AU (dans le séchoir 5)

voila le code que monsieur Jpbt84 ma écris et qui fonctionne mais il repond pas exactement a ce que je veux :

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
            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
                            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

voila le code que j'ai modifier mais il fonctionne pas

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
            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
                            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
                            Set celluleapro = Range("AE:AE").Find(Range("AN" & CptLigne).Value, lookat:=xlWhole)
                                Range("AU" & celluletrouvee.Row + 1).Value = Range("AE" & CptLigne).Value
                                'UniteLavage
                                Range("AE" & CptLigne).Value = ""
                                Application.Wait Time + TimeSerial(0, 0, 1)
                                Range("AE" & CptLigne).Value = Range("AD" & CptLigne).Value
                                 Range("AD" & CptLigne).Value = Range("AC" & CptLigne).Value
                                  Range("AC" & CptLigne).Value = Range("AB" & CptLigne).Value
                                   Range("AB" & CptLigne).Value = Range("AA" & CptLigne).Value
                                    Range("AA" & CptLigne).Value = Range("AZ" & CptLigne).Value
                            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

merci beaucoup