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
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
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
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
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
Re, salut gosselien,
Et n'en parlons plus :
A+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 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