Raccourcir une boucle pour éviter une grosse latence

Bonjour à tous,

Je débute un peu avec VBA dans la cadre professionnel. J'ai programmé une macro qui réactualise l'affichage de ma base de données dans une table spécifiquement prévue à cet effet.
La base de donnée a environ 45 entrées et est en Feuille 2.
L'afficheur est situé en Feuille 1. Cette macro s'exécute en cliquant sur un bouton d'une autre feuille permettant de revenir à la Feuille 1 à jour.

Cependant quand je l'exécute, elle met bien 10 secondes à charger la Feuill 1 et passe par un "Excel ne Répond Plus" pendant ce temps.
1- Est-ce normal ?
2 - Y a-t-il un moyen d'éviter ça, peut être en raccourcissant la boucle de copie (chose que je ne sais pas faire) ?

Je vous laisse ci-dessous le code pour y voir plus clair.

Merci par avance pour l'aide que vous pourrez m'apporter

Sub ReturnToApp()
Dim IndexRow As Integer 'Indice de ligne dans la base
Dim IndexNewTable As Integer 'Indice de ligne correspondant dans l afficheur
IndexNewTable = 24 'debut de l'afficheur en igne 24
Sheets(1).Range("D24:AB167").Value = Empty 'Vider l'afficheur
For IndexRow = 3 To Sheets(2).Range("A999").End(xlUp).Row 'Pour chaque entree de la bdd
With Sheets(1)
.Range("D" & IndexNewTable).Value = Sheets(2).Range("A" & IndexRow).Value 'placer l'entree correctement dans la feuille 1
.Range("E" & IndexNewTable).Value = Sheets(2).Range("B" & IndexRow).Value
.Range("G" & IndexNewTable).Value = Sheets(2).Range("C" & IndexRow).Value
.Range("H" & IndexNewTable).Value = Sheets(2).Range("D" & IndexRow).Value
.Range("J" & IndexNewTable).Value = Sheets(2).Range("E" & IndexRow).Value
.Range("L" & IndexNewTable).Value = Sheets(2).Range("F" & IndexRow).Value
.Range("P" & IndexNewTable).Value = Sheets(2).Range("G" & IndexRow).Value
.Range("T" & IndexNewTable).Value = Sheets(2).Range("H" & IndexRow).Value
.Range("X" & IndexNewTable).Value = Sheets(2).Range("I" & IndexRow).Value
.Range("AA" & IndexNewTable).Value = Sheets(2).Range("J" & IndexRow).Value
.Range("AC" & IndexNewTable).Value = IndexRow 'cle d indice d'une feuille a l autre
.Range("AB" & IndexNewTable).Value = Sheets(2).Range("N" & IndexRow).Value
    IndexNewTable = IndexNewTable + 1 'entree suivante
End With
Next IndexRow
Sheets(1).Select ' se rendre en feuille 1 et premiere entree
Sheets(1).Range("D24").Select
End Sub