Construire une Boucle

Bonjour,

Je voudrais colorier un carte du monde en fonction du nom du Pays et de si le pays est associé à la lettre "x". J'ai réussi avec le code suivant pour deux pays. Mais je voudrais le faire avec une boucle : tant que la case Pays n'est pas vide faire ... puis passe a la cellule d'en dessous.

Sub Colorier()
'
' Macro1 Macro
'
If Range("O8") = "x" Then

  ActiveSheet.Shapes("France").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
Else
    ActiveSheet.Shapes("France").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = RGB(255, 255, 255)
        .TintAndShade = 0
End With
End If


If Range("O9") = "x" Then

  ActiveSheet.Shapes("Germany").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
Else
    ActiveSheet.Shapes("Germany").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = RGB(255, 255, 255)
        .TintAndShade = 0
End With


End If

End sub

J'ai essayer pour la boucle avec le VBA suivant mais ca ne focntionne pas :

Sub Boucle()
Dim i As Integer
i = 8
Dim Pays As String
Pays = Range("N" & i).Value

Do While Range("N" & i) <> "" 'Faire la boucle tant que la cellule sélectionée n'est pas vide
   
If Range("O" & i) = "x" Then

  ActiveSheet.Shapes(Pays).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
Else
ActiveSheet.Shapes(Pays).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = RGB(255, 255, 255)
        .TintAndShade = 0
End With
End If
i = i + 1 'Décalage de 1 ligne à chaque fois
Loop

End Sub

Merci d'avance pour votre Aide !!!