ligne colorée

[eutrophisation]

Bonjour

SVP pourriez vous me completer le code afin d'optimiser la ligne.
MERCI D'AVANCE

 

[CHALET53]

Re : ligne colorée

bonjour,

J'ai complété (sans chercher à comprendre le but recherché)


Private Sub Worksheet_Change(ByVal Target As Range)
'Stop
Set champ = Range("a21:bp5020")
If Not Intersect(champ, Target) Is Nothing And Target.Count = 1 Then
champ.Interior.ColorIndex = xlNone
col1 = champ.Column
col2 = col1 + champ.Columns.Count - 1
a = Target.Value
Select Case Target.Value

Case "setude"
Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Interior.ColorIndex = 53
Case "secteur"
Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Interior.ColorIndex = 13
Case "surveillance"
Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Interior.ColorIndex = 41
End Select
Dim plg
Set plg = Intersect(Rows(Target.Row), Range("f21:f5020"))
If Target.Rows.Count = 1 And Not plg Is Nothing Then [c1].Value = plg.Value
Application.Goto Reference:=Worksheets(ActiveSheet.Name).Range(ActiveCell.Address), Scroll:=True
End If
End Sub


A suivre

 

[eutrophisation]

Re : ligne colorée

Désolé cela ne fonctionne pas...

 

[CHALET53]

Re : ligne colorée

Je plante effectivement sur la ligne Application.Goto .... (en effet,il faut recoller Acti veCell)
Autrement si je saisis surveillance ou secteur la couleur change

Dim plg
Set plg = Intersect(Rows(Target.Row), Range("f21:f5020"))
If Target.Rows.Count = 1 And Not plg Is Nothing Then [c1].Value = plg.Value
Application.Goto Reference:=Worksheets(ActiveSheet.Name).Range(Acti veCell.Address), Scroll:=True