Poner nombres a las celdas con macro

Un gran amigo me sugirió este código, para asignar nombres a
determinadas celdas, de acuerdo a valores que están en otras celdas:

Sub MakeRange()
For i = 1 To 5
nombre = Cells(i, "A") & "_Juegos"
a = ActiveWorkbook.Names.Add(nombre, Sheets(1).Cells(i, "D"))
Next
End Sub

Se supone que los nombres para ser asignados están en A1:A5 y que
deben asignarse a las celdas del rango D1:D5.

Ahora bien, sólo me sirve para asignar el nombre a la última celda.
Cómo se haría para asignar el nombre a todas las celdas.? Me explico
mejor con éste ejemplo. En el rango A1:A5 aparece 3 veces "Paraguay",
entonces el nombre "Paraguay_Juegos" debe ser asignado a las 3 celdas
donde aparece esa palabra, pero éste código sólo asigna a la última
aparición.

Gracias por la ayuda...

Robert