Comment insérer ligne égale valeur cellule ?

Bonjour j'ai réussi a faire un déplacement des nombres mais je n'arrive toujours pas a déplacés le texte.
Le code pour l'instant ressemble a sa :

Sub Lecture_ligne()
'Compter le nombres de lignes
nb_lignes = WorksheetFunction.CountA(Range("A:A"))

For i = 1 To 1000
Range("A" & i).Select
n = Range("A" & i).Value
If i < n Then
Selection.Insert Shift:=xlDown
End If
Next

End Sub

Mon code fonctionne puisque dans le fichier réel à traiter, il n'y a aucun espace entre chaque nombre. Si vous avez une solution pour que le texte ce déplace en même temps que le nombre sa serait super.

Re,
Si tu déplaces une ligne pour la mettre dans une autre ligne déjà remplie, tu perd ses données.
Un p’tit classeur avec 10/15 données serait mieux pour régler le soucis :yum:

Tu vas dans https://www.cjoint.com/ ou dans https://mon-partage.fr/
Tu cliques sur "PARCOURIR" pour sélectionner ton fichier
Clic le bouton "CREER LE LIEN"
Clic droit quand le lien est créé "COPIER LE LIEN"
Sur ton message Clic droit "Coller".

Nouveau code il déplace le texte et les nombres, ne manque plus que à faire fonctionner la macro dès son ouverture si vous avez une idée je suis preneur.
Nouveau code :

Sub Lecture_ligne()
'Compter le nombres de lignes
nb_lignes = WorksheetFunction.CountA(Range("A:A"))

For i = 1 To 1000
n = Range("A" & i).Value
If i < n Then
Range("A" & i).Select
Selection.Insert Shift:=xlDown
Range("B" & i).Select
Selection.Insert Shift:=xlDown
End If
Next

End Sub