Geschwindigkeit optimieren

Hat jemand vielleicht noch jemand eine Idee, wie man den Ablauf hier optimieren könnte?

Sub Farbenzählen()

Dim Zelle As Object
Dim gelb%, grün%, blau%

For z = 2 To 21

gelb = 0: grün = 0: blau = 0

For Each Zelle In Range(Cells(3, z), Cells(99, z))
Select Case Zelle.Interior.ColorIndex
Case 6: gelb = gelb + 1
Case 50: grün = grün + 1
Case 5: blau = blau + 1
End Select

Cells(100, z).Value = grün
Cells(102, z).Value = gelb
Cells(104, z).Value = blau

Next
Next

End Sub

Grüße
Peter