Problem mit Case

Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Bereich As Range
Dim rng As String
Dim bool As Boolean
Set Bereich = Range("B3:B156")
Application.EnableEvents = False
bool = UCase(Target.Text) Like "[A-I]"
If bool Then
If Not Intersect(Target, Bereich) Is Nothing And Target.Offset(0, -1).Text  "" Then
Select Case Target.Text
Case "a", "A": rng = "C500:AG500"
Case "b", "B": rng = "C501:AG501"
Case "c", "C": rng = "C502:AG502"
Case "d", "D": rng = "C503:AG503"
Case "e", "E": rng = "C504:AG504"
Case "f", "F": rng = "C505:AG505"
Case "g", "G": rng = "C506:AG506"
Case "h", "H": rng = "C507:AG507"
Case "i", "I": rng = "C508:AG508"
Case "a1", "A1": rng = "C509:AG509"
Case "b1", "B1": rng = "C510:AG510"
Case "c1", "C1": rng = "C511:AG511"
Case "d1", "D1": rng = "C512:AG512"
Case "e1", "E1": rng = "C513:AG513"
Case "a2", "A2": rng = "C514:AG514"
Case "b2", "B2": rng = "C515:AG515"
Case "c2", "C2": rng = "C516:AG516"
Case "d2", "D2": rng = "C517:AG517"
Case "e2", "E2": rng = "C518:AG518"
End Select
End If
Application.CutCopyMode = False
End If
Application.EnableEvents = True
End Sub