Déplacer les valeurs selon une information
Bonjour le forum
j'ai besoin de votre aide en faite
je voudrai que SI et seulement SI il y a une valeur au compte 46705000 (Ligne jaune ) cela déplace la les compte 7072000 et 44571200 (CASE ROUGE) en débit qui étais en crédit et cela sur toutes la colonnes
Voici un fichier "ex" la feuille de base et le résultat voulu j'ai essayer avec un code qui permet de couper la cellules mais rien ne change
un des collègues du forum m'a aider et ma fais ce code mais je n'arrive pas a le faire fonctionner
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$E$25" Then Exit Sub 'si le changement à lieu ailleurs que dans la cellule E25 (cible), sort de la procédure
If Target <> "" Then 'condition : si la cible est différente du vide
Range("D6").Value = Range("E6").Value 'récupère en D6 la valeur de E6
Range("D7").Value = Range("E7").Value 'récupère en D7 la valeur de E7
Range("E6:E7").ClearContents 'efface E6:E7
End If 'fin de la condition
End Subcordialement
Bonjour DragZ,
Note : Ah! le vilain ... il a fait 2 demandes sur le même sujet ...
https://forum.excel-pratique.com/excel/deplacer-une-cellules-selon-valeurs-174635
...
Attention : le code contient une erreur, sur la ligne testée répondant aux critères ... si le montant est dans Débit au lieu d'être dans Crédit ... il va être écrasé par le contenu de la cellule Crédit qui est vide .... Voir nouveau code dans mon post plus bas .
M'enfin voici quand même ...
À placer dans la feuille concernée (Base) ...
La ligne du compte 46705000 peut être à n'importe quelle hauteur dans la liste ...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Integer, dLig As Integer
If Target.Count > 1 Then Exit Sub
dLig = Cells(Rows.Count, "A").End(xlUp).Row
If Not Intersect(Target, Range("E6:E" & dLig)) Is Nothing Then
If Target.Value > 0 And Target.Offset(0, -2).Value = 46705000 Then
For x = 6 To dLig
If Cells(x, "C").Value = 70720000 Or Cells(x, "C").Value = 44571200 Then
Application.EnableEvents = False
Cells(x, "D").Value = Cells(x, "E").Value
Cells(x, "E").ClearContents
Application.EnableEvents = True
End If
Next x
End If
End If
End Subric
Merci de votre réponse
et desolé comme j'etais en vacances entre temps j'ai pas repris l'ancien post
sachez que je vous remercie beaucoup cela dit votre code a l'air super complexe je vais essayer de le comprendre en m'entrainant mais cela fonctionne merci beaucoup :) :) :)
Bonjour DragZ,
L'événement de déclenche sur n'importe quelle cellule de la colonne E ...
Si la cellule 2 colonnes à gauche contient 46705000 ... le code balaie la colonne C ... si une cellule contient 70722000 ou 44571200 ... l'info est déplacée ...
ric
Bonjour DragZ, le forum,
Attention : Grosse erreur dans le code précédent ... s'il y a un montant dans Débit ... il va être écrasé ...
C'est seulement si le montant est dans Crédit qu'il faut procéder au déplacement ...
Une correction au code précédent ...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Integer, dLig As Integer
If Target.Count > 1 Then Exit Sub ' Si plus d'une cellule est sélectionnée, sortir
dLig = Cells(Rows.Count, "A").End(xlUp).Row ' trouver la dernière ligne
If Not Intersect(Target, Range("E6:E" & dLig)) Is Nothing Then ' plage à tester
If Target.Value > 0 And Target.Offset(0, -2).Value = 46705000 Then ' si pas vide et bon no de compte
For x = 6 To dLig ' balayer de la ligne 6 jusqu'à la fin de la plage
If Cells(x, "C").Value = 70720000 Or Cells(x, "C").Value = 44571200 Then ' condition
If Cells(x, "E").Value > 0 Then ' si cellule Crédit n'est pas vide
Application.EnableEvents = False ' suspendre les événements
Cells(x, "D").Value = Cells(x, "E").Value ' copier la donnée dans débit
Cells(x, "E").ClearContents ' vider le crédit
Application.EnableEvents = False ' réactiver les événements
End If
End If
Next x
End If
End If
End Subric