Amélioration de macro

Bonjour,
J'ai créé une macro me permettant de copier coller une valeur de cellule sur celle d'en dessous jusqu'à ce qu'il trouve une autre, qu'il copie ensuite etc...
'
Sub HRPP_CopieHR()
x = 1
Do While x < 5000
Do Until ActiveCell <> Empty
ActiveCell.Offset(-1, 0).Range("A1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
ActiveCell.Offset(1, 0).Range("A1").Select
x = x + 1
Loop
End Sub
'
Par exemple, si j'ai :
850
_
_
_
912
_
_
_
_
815
_
...

Il me le transformera en
850
850
850
850
912
912
912
912
912
815
815
...
Cependant, mes fichiers font en moyenne 600 000lignes, et pour exécuter cette macro, mon ordinateur prend plus de 2heures, sachant que j'ai 50fichiers du genre à traiter, vous comprendrez que je cherche à améliorer celle-ci
Les données se trouve dans la colonne D, l'espace entre deux valeurs n'est pas constant, et j'ai environ 4000valeurs.
L'idée serait de copier coller une valeur sur l'ensemble des cellules vides en dessous plutôt que de copier coller les cellules une par une, avec une fonction "Autofit" par exemple...

Cependant mes différents essais se sont révéler infructueux, j'en appel à vous !

Merci d'avance