Re : Couleur de Cellule en fonction d'une sélection
Re bonjour j'ai rencontré un nouveau soucis les ligne de code marche bien, mais elles empeche une macro de fonctionner correctement. voici ce qu'il y a dans ma feuille
Sub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 09/11/2011 par Jul
'
'
Range("K4
16").Select
Selection.Copy
Range("Q4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Q5:V16").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("V5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("E11").Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("k3") = 1 Then
Macro2
Else
Exit Sub
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address(0, 0) = "B7" Or Target.Address(0, 0) = "B8" Then
Range("A12").Interior.ColorIndex = 48
Else
Range("A12").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "E7" Or Target.Address(0, 0) = "E8" Then
Range("A13").Interior.ColorIndex = 48
Else
Range("A13").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "H7" Or Target.Address(0, 0) = "H8" Then
Range("A14").Interior.ColorIndex = 48
Else
Range("A14").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "B5" Or Target.Address(0, 0) = "B6" Then
Range("A15").Interior.ColorIndex = 48
Else
Range("A15").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "E5" Or Target.Address(0, 0) = "E6" Then
Range("A16").Interior.ColorIndex = 48
Else
Range("A16").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "H5" Or Target.Address(0, 0) = "H6" Then
Range("A17").Interior.ColorIndex = 48
Else
Range("A17").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "B6" Or Target.Address(0, 0) = "B8" Then
Range("A18").Interior.ColorIndex = 48
Else
Range("A18").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "E6" Or Target.Address(0, 0) = "E8" Then
Range("A19").Interior.ColorIndex = 48
Else
Range("A19").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "H6" Or Target.Address(0, 0) = "H8" Then
Range("A20").Interior.ColorIndex = 48
Else
Range("A20").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "B5" Or Target.Address(0, 0) = "B7" Then
Range("A21").Interior.ColorIndex = 48
Else
Range("A21").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "E5" Or Target.Address(0, 0) = "E7" Then
Range("A22").Interior.ColorIndex = 48
Else
Range("A22").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "H5" Or Target.Address(0, 0) = "H7" Then
Range("A23").Interior.ColorIndex = 48
Else
Range("A23").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "B5" Or Target.Address(0, 0) = "B8" Then
Range("A24").Interior.ColorIndex = 48
Else
Range("A24").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "E5" Or Target.Address(0, 0) = "E8" Then
Range("A25").Interior.ColorIndex = 48
Else
Range("A25").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "H5" Or Target.Address(0, 0) = "H8" Then
Range("A26").Interior.ColorIndex = 48
Else
Range("A26").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "B6" Or Target.Address(0, 0) = "B7" Then
Range("A27").Interior.ColorIndex = 48
Else
Range("A27").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "E6" Or Target.Address(0, 0) = "E7" Then
Range("A28").Interior.ColorIndex = 48
Else
Range("A28").Interior.ColorIndex = 2
End If
If Target.Address(0, 0) = "H6" Or Target.Address(0, 0) = "H7" Then
Range("A29").Interior.ColorIndex = 48
Else
Range("A29").Interior.ColorIndex = 2
End If
End Sub
un bug type 1004 sur le pastespecial apparait.....