Déplacer pair

Bonjour à tous et mille fois merci pour votre aide

J'ai ceci qui fonctionne:

Dim cel As Range
For Each cel In Range('C1:C' & Range('C65536').End(xlUp).Row)
If cel.Text = 'Test' Then
cel.Offset(0, 0).Cut Destination:=cel.Offset(0, 1)
End If
Next cel

La question: Comment y faire déplacer les nombres pairs?

Du genre
Dim cel As Range
For Each cel In Range('C1:C' & Range('C65536').End(xlUp).Row)
If cel.Text = Mod (cell;2) Then
cel.Offset(0, 0).Cut Destination:=cel.Offset(0, 1)
End If
Next cel

Merci

Temjeh