Appliquer une macro a plusieurs cellules
Bonjour à tous,
Actuellement j'ai une macro qui permet de copier en C35 la valeur de B36 (ma valeur "source") si C36 = X SINON la valeur de C35 est figé.
RESUME : Si C36 = X alors C35 = B36
SINON C36 se fige (garde la derniere valeur ajoutée)
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Err_Worksheet_Change
Dim Cell_Cde, Cell_Source, Cell_Destination As Range
Dim Str_Msg As String
Set Cell_Cde = Range("C36")
Set Cell_Source = Range("B36")
Set Cell_Destination = Range("C35")
Str_Msg = "=indirect(" & Cell_Source.Address & ")"
If Intersect(Target, Cell_Cde) Is Nothing Then GoTo Sort_Worksheet_Change
If UCase(Target) = "X" Then
Cell_Destination.FormulaR1C1 = "=indirect(""" & Cell_Source.Address & """)"
Else
Cell_Destination.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Target.Select
End If
Sort_Worksheet_Change:
Exit Sub
Err_Worksheet_Change:
MsgBox (Err.Number & " - " & Err.Description)
Resume Sort_Worksheet_Change
End SubJ'aimerais pouvoir appliquer cette macro a la colonne D, E, F ect... tout en gardant comme source de valeur B36.
C'est a dire simplement que pour la colonne suivante :
SI D36 = X ALors D35 = B36
SINON D36 se fige
Et faire pareil avec E35 puis F35 ect...
Coment faire cela ?
Merci beaucoup, bonne journée !
Bonsoir,
J'ai modifié un peu ton code, j'ai mais comme plage les colonnes C à E mais tu peux changer pour mettre ta dernière colonne.
J'ai changé Cell_Destination.FormulaR1C par Cells(Target.Row - 1, Target.Column).Value pour ne prendre que la colonne où on vient d'écrire un X ou effacer le X et ne pas s'occuper des autres qui contiennent peut-être aussi un X ou rien.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Err_Worksheet_Change
Dim Cell_Cde, Cell_Source, Cell_Destination As Range
Dim Str_Msg As String
Set Cell_Cde = Range("C36:E36")
Set Cell_Source = Range("B36")
Set Cell_Destination = Range("C35:E35")
Str_Msg = "=indirect(" & Cell_Source.Address & ")"
If Intersect(Target, Cell_Cde) Is Nothing Then GoTo Sort_Worksheet_Change
If UCase(Target) = "X" Then
Cells(Target.Row - 1, Target.Column).Value = "=indirect(""" & Cell_Source.Address & """)"
'Cell_Destination.FormulaR1C1 = "=indirect(""" & Cell_Source.Address & """)"
Else
Cells(Target.Row - 1, Target.Column).Select
'Cell_Destination.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Target.Select
End If
Application.CutCopyMode = False
Sort_Worksheet_Change:
Exit Sub
Err_Worksheet_Change:
MsgBox (Err.Number & " - " & Err.Description)
Resume Sort_Worksheet_Change
End SubA+