Plusieurs conditions dans Excel en VBA

Salut tout le monde,
j'ai besoin de ch'ti coup de main pour adapter ce code que j'ai trouvé dans
le forum (merci à son concepteur...). Les conditions sont les suivantes :
dans la cellule G3, un chifre de -4 à >1. Dans H3, un autre chiffre en
fonction de G3 et ainsi de suite jusqu'à G1000. Exprimé autrement, ça
donnerait quelque chose comme ça :
si G3:G1000 >1; H3:H1000=0
si G3:G1000 = 1; H3:H1000= 1
si G3:G1000 = 0; H3:H1000= 2
si G3:G1000 = -1; H3:H1000= 3
si G3:G1000 = -2; H3:H1000= 4
si G3:G1000 = -3; H3:H1000= 5
si G3:G1000 = -4; H3:H1000= 6

Comment l'adapter à ce code-là ??? Ou, si ce n'est pas possible, comment
faire ??

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target.Cells, Range("A1:A10")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case "1": c.Font.ColorIndex = 3: c.Interior.ColorIndex = 1
Case "2": c.Font.ColorIndex = 2: c.Interior.ColorIndex = 2
Case "3": c.Font.ColorIndex = 4: c.Interior.ColorIndex = 3
Case "4": c.Font.ColorIndex = 23: c.Interior.ColorIndex = 4
Case "5": c.Font.ColorIndex = 13: c.Interior.ColorIndex = 5
Case "6": c.Font.ColorIndex = 9: c.Interior.ColorIndex = 6
Case Else: c.Font.ColorIndex = xlAutomatic:
c.Interior.ColorIndex = xlNone
End Select
Next
End If
End Sub

Merci d'avance !

PS : je l'ai également mis dans le forum Excel au cas où...

--
Céd / Lausanne