Probléme en VBA EXCEL

Bonjour,

j'ai une boucle dans une partie de mon programme qui en comparant des valeurs devrait en insérer dans des cellules , mais elle ne fait rien ....
Si quelqu'un peut me venir en aide , merci.

Dim Case_1 As String
Dim Case_2 As String
Dim Case_3 As Range
Dim Case_4 As Range


Case_1 = feuilleprinc.Range("B26").Value
Case_2 = feuilleprinc.Range("B57").Value
Dim nom As Range
Set nom = feuilleprinc.Range("B27")




With feuilleprinc

Set Case_4 = Range("B187:B290")

For Each Cellule In Case_4

If Cellule.Value > Case_1 And Cellule.Value < Case_2 Then

MsgBox " insertion valeur"

nom.Value = Cellule.Value

nom = nom.Offset(1, 0)

Cellule = Cellule.Offset(1, 0)

ElseIf Cellule.Value < Case_1 Then

Cellule = Cellule.Offset(1, 0)

Else

Exit For

End If

Next
End With