Fonction pour déplacer une cellule à une autre

[ExcelDow]

Bonjour à tous,

Dans ce classeur j'aimerais déplacer le montant se trouvant dans la colonne C à D, si le mot "Remboursé" se trouve dans la colonne B, mais avec une fonction SI: Si c'est possible bien sure
Voici le classeur

Merci A ++++++

 

[Chris401]

Bonsoir

Essaye :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B:B")) Is Nothing And Target.Count = 1 Then
    If UCase(Target) = "OUI" Then
        Target.Offset(0, 2) = Target.Offset(0, 1)
        Target.Offset(0, 1) = ""
    End If
End If
End Sub

Cordialement
Chris

 

[job75]

Bonjour ExcelDow, Chris401, le forum,

Ceci :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, [B:B], Me.UsedRange)
If Not r Is Nothing Then
  For Each r In r 'si effacements ou entrées multiples (copier-coller)
    If r = "Remboursé" And r(1, 2) <> "" Then _
      r(1, 3) = r(1, 2): r(1, 2) = ""
  Next
End If
End Sub

Ou cela :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, [B:B], Me.UsedRange)
If Not r Is Nothing Then
  For Each r In r 'si effacements ou entrées multiples (copier-coller)
    If r(1, 2) <> "" Then
      If r = "Remboursé" Then
        r(1, 3) = r(1, 2): r(1, 2) = ""
      Else
        r(1, 3) = 0 'r = ""
      End If
    End If
  Next
End If
End Sub

Bonne journée.

 

[ExcelDow]

Bonjour Chris401 et job75,

Merci beaucoup,
J'essaye tous ca et vous redis
A++++
Bonne journée

 

[job75]

Re,

Sur un grand tableau, si l'on fait un copier-coller de la colonne B sur elle-même, la 2ème macro du post #3 peut prendre du temps.

Avec un tableau VBA c'est plus rapide :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, t, i&
Set P = Range("A1:D1", Me.UsedRange)
t = P.Formula 'matrice, plus rapide
For i = 1 To UBound(t)
  If t(i, 3) <> "" Then
    If t(i, 2) = "Remboursé" Then
      t(i, 4) = t(i, 3): t(i, 3) = ""
    Else
      t(i, 4) = 0 't(i, 4) = ""
    End If
  End If
Next
Application.EnableEvents = False
P = t
Application.EnableEvents = True
End Sub

A+

 

[ExcelDow]

Re,

Alors je choisi ce code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, [B:B], Me.UsedRange)
If Not r Is Nothing Then
For Each r In r 'si effacements ou entrées multiples (copier-coller)
If r(1, 2) <> "" Then
If r = "Remboursé" Then
r(1, 3) = r(1, 2): r(1, 2) = ""
Else
r(1, 3) = 0 'r = ""
End If
End If
Next
End If
End Sub


J'aimerais juste savoir si possible, si je reviens en arrière,
c'est à dire je change le mot "Remboursé" par un autre mot "oui" "non" "En suspend" ou encore d'autres,
alors il faudrait que la valeur qui à passée dans la colonne "D" revient dans la colonne "C" et affiche un "0"

Je te remercie d'avance Job75
A+++++

 

[ExcelDow]

Re Job75 et Chris401,

Idéalement, si on pourrais créer cette situation selon mes notes sur la feuille 1
Mais comme je suis nul en VBA, pour moi, c'est pas réalisable
Merci A+++++

 

[job75]

Re,

Que vous soyez nul en VBA peu importe.

Ce qu'il faut c'est être clair et précis dans vos demandes.

Le post #7 ne colle pas avec le post #6, quelle est votre demande définitive ?

Prenez le temps de réfléchir car il n'est pas question de passer des heures sur ce fil.

A+

 

[ExcelDow]

Re, Job75
Je pense être clair comme ceci, et excuse pour mon erreur

1. Si le mot en colonne B est remboursé, le montant colonne C passe en colonne D
2. Si le mot en colonne B est En attente, il reste en colonne C
3. Si le mot en colonne B est payé, il passe en colonne E

Merci Job75 de ta précieuse aide

 

[gosselien]

Bonjour,

Excedow--->une "fonction" ne pourra jamais déplacer quoi que se soit ...

P.

 

[job75]

Re, salut gosselien,

Et n'en parlons plus :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, [B:B], Me.UsedRange)
If Not r Is Nothing Then
  For Each r In r 'si effacements ou entrées multiples (copier-coller)
    If r(1, 2) <> "" Then
      If LCase(r) = "remboursé" Then
        r(1, 3) = r(1, 2): r(1, 2) = ""
      ElseIf LCase(r) = "payé" Then
        r(1, 4) = r(1, 2): r(1, 2) = ""
      Else
        r(1, 3) = 0 'r = ""
      End If
    End If
  Next
End If
End Sub

A+

 

[ExcelDow]

OK, merci du renseignement,

 

[job75]

ExcelDow,

Nos posts se sont croisés, voyez le post #11.

A+

 

[ExcelDow]

Re, salut gosselien,

Et n'en parlons plus :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, [B:B], Me.UsedRange)
If Not r Is Nothing Then
  For Each r In r 'si effacements ou entrées multiples (copier-coller)
    If r(1, 2) <> "" Then
      If LCase(r) = "remboursé" Then
        r(1, 3) = r(1, 2): r(1, 2) = ""
      ElseIf LCase(r) = "payé" Then
        r(1, 4) = r(1, 2): r(1, 2) = ""
      Else
        r(1, 3) = 0 'r = ""
      End If
    End If
  Next
End If
End Sub

A+

Ho lalala, super le code, alors vraiment c'est très gentil d'avoir pris un peux de temps pour mon problème de code,
Je vous remercie vivement, Job75, et grosselien, et vous souhaite une bonne continuation dans ce que vous faites.
MERCI