Microsoft 365 Ecrire dans une cellule suivant une autre en VBA

[Francky79]

Bonjour le forum,

Je sollicite votre aide pour la modification d’un code VBA

Private Sub Worksheet_Change(ByVal Target As Range)
'si la colonne de la cellule modifiée est différente de 11 (=> colonne K), sort de la procédure
 If Target.Column <> 38 Then Exit Sub
'si la cellule en colonne K est non vide, envoie "ENLEVÉ" dans la colonne U
If Target.Value <> "" Then
     Target.Offset(0, -1).Value = "x"
Else
     Target.Offset(0, -1).Value = ""
End If
End Sub

Dans ce code quand je rentre une valeur en AL6, dans AK6 la valeur passe à x en automatique.
Si je supprime la valeur en AL6 la cellule AK6 redevient vide
Je voudrais faire pareil en AM6, si valeur dans AM6 AL6 passe à x, si je supprime la valeur en AM6, AL 6 revient vide.
Et je voudrais limiter la zone de AK6 :AM500
Par contre dans (Worksheet_Change) il y a déjà un code, je voudrais mettre celui-ci à suivre.

Merci pour votre aide.

 

[patricktoulon]

bonjour
supposons qu'en AL6 je tape un truc donc en AK6 j'aurais un " x "(ça c'est ok )
maintenant par la suite je tape un autre truc en AM6 je vais donc avoir un "x" en AL6
je perds donc la donnée précédemment taper en AL6

 

[sylvanu]

Bonjour Francky,
Pouvez vous fournir un fichier test avec la macro Worksheet_Change déjà existante pour modification ?
Autre question, pas tout compris à :

Je voudrais faire pareil en AM6, si valeur dans AM6 AL6 passe à x, si je supprime la valeur en AM6, AL 6 revient vide.

Si je supprime la valeur en AM6, AL 6 revient vide. Donc AL6 étant vide, alors AK6 redevient vide. C'est ça ?

 

[Lolote83]

Bonjour,
Je crois qu'il y a un petit problème.

Tu dis : valeur en AL6, dans AK6 la valeur passe à x

Donc si on saisie une donnée en AL6, AK6 passe à "x" et donc inversement si AL6 est supprimée, AK6 passe à vide.
Par contre, si AM6 = quelque chose, tu demandes à ce qu'AL6 passe à "x" donc dans ce cas, tu supprimes ce qui avait été saisi au préalable en AL6. N'y a -t-il pas erreur sur les cellules ?
@+ Lolote83
Edit : Bonjour @patricktoulon , @sylvanu

 

[Francky79]

Merci pour votre aide,

Pour les cellules AL-- AK-- et AM-- c'est bien ça que je voudrais.
Le code déjà présent dans Sub Worksheet_Change

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&
Set Target = Intersect(Target, [V:V], UsedRange)
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
With Feuil3 'CodeName à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    For Each Target In Target 'si entrées/effacements multiples
        If Target.Row > 1 Then
            If LCase(Target) = "t" Then
                i = 0
                i = Application.Match(Target(1, 0), .Columns(1), 0)
                If i = 0 Then i = .Cells(.Rows.Count, 1).End(xlUp).Row + 1: .Cells(i, 1) = Target(1, -20)
                'Hyperlinks.Add Target(1, 2), "", .Name & "!" & .Cells(i, 1).Address(0, 0), TextToDisplay:="OA"
            ElseIf Target = "" Then
                Target(1, 2).Clear 'RAZ
                .Rows(Application.Match(Target(1, -19), .Columns(1), 0)).Delete
            End If
        End If
    Next
End With
[V:V].HorizontalAlignment = xlCenter 'centrage
    Application.EnableEvents = True 'réactive les évènements

End Sub