Selectionner plusieurs fois même info word pour copier ds excel

Sub import_word()

 ' -- Déclaration des variables
    Dim wb As Workbook          'classeur Excel dans lequel on importe les données
    Dim ws As Worksheet         'onglet Excel dans lequel on importe les données
    Dim sChemin As String       'répertoire contenant les fichiers Word
    Dim sNomFichier As String   'nom du fichier Word
    Dim WApp As Object, WDoc As Object, WSel As Object
    Dim i As Integer
    Dim Text As String
    Dim nbipa As Integer
    Dim country As String
    
' -- Initialisation des variables
    Set wb = ThisWorkbook                       'on travaille sur ce fichier excel
    Set ws = wb.Sheets(1)                       'on sauvegarde dans la 1re feuille
    sChemin = ThisWorkbook.Path & "\"           'si les fichiers Word se trouvent dans le même répertoire que le fichier Excel
    
    sNomFichier = "algeria.doc"
    nbipa = 20 'nombre dIPA dans le pays, attention a avoir le nombre exact sinon rajout de lignes
    country = "Algeria"

    Set WApp = CreateObject("Word.Application")
    WApp.Visible = True                        'ne pas afficher Word pendant l'exécution
    
    i = 1   '1re ligne où on va écrire les données dans le fichier Excel
    
    Application.ScreenUpdating = False

    Set WDoc = WApp.Documents.Open(sChemin & sNomFichier)   'ouvre le document Word
   
' SITE NAME (International name)
    WApp.Selection.HomeKey unit:=6
    For i = 1 To nbipa
        WApp.Selection.Find.ClearFormatting
        WApp.Selection.Find.Execute "SITE NAME (International name):"    'On trouve le texte "SITE NAME (International name):"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=2   'On se déplace de 3 mots
        Set WSel = WApp.Selection                   'sélection du texte trouvé
        ws.Cells(i + 1, 1) = Split(WSel, ":")(1)
        WApp.Selection.Find.Execute Replace:=wdReplaceOne
        With WApp.Selection.Find
            .Text = "SITE NAME (International name):"
            .Replacement.Text = "SITE NAME (International name) DONE :"
        End With
        WDoc.Save
    Next

    Application.ScreenUpdating = True
    WApp.Quit
    
End Sub