Code troooop lent à s'exécuter

Bonjour la communauté me voici de nouveau.

J'ai fais un code qui fonctionne mais qui mets trop de temps à s'exécuter. L'idée est de copier et coller une cellule cells(j,3) où j = 2 To 2000

J'aimerais alors savoir si c'est les 2000 sont à l'origine de cette immense lenteur ?

Voici mon code :

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim Col As Integer, EnregExiste As Boolean, j As Integer
With Sheets("MASS SALAIRE")
    For Col = 4 To .Cells(1, Columns.Count).End(xlToLeft).Column
        If .Cells(1, Col) = TextBox1 Then EnregExiste = True: Exit For
    Next Col

    If Not EnregExiste And .Cells(1, Col) = "" Then
    .Cells(1, Col) = TextBox1

' à partir de la le problème ... je n'ai pas réussi à faire tirer vers le bas qui pourrait être plus rapide que de copier à chaque fois cells(j,3) et la copier ... 

        For j = 2 To 2000
        .Cells(j, 3).Copy
        .Cells(j, Col).PasteSpecial xlPasteFormulas
        Next j
    End If
End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

Merci pour votre collaboration les amis :)

Me

Re-,

Peut-être ainsi :

.....
.....
        .Cells(2, 3).Resize(2000).Copy
        .Cells(2, Col).PasteSpecial xlPasteFormulas
....
....

et tu supprimes "For j" et "Next j"

Peut-être?

c'est top top top top top top !

merci infiniment cous :) c'est une sore de retirer vers le bas ça ou plutôt une seule copie sur toute la plage de 2 à 2000 et une seule copie. C plutôt ça ;)

Re-,

Euh, si je comprends ton questionnement...

Effectivement, je copie toute la plage (De C2 à C2001), et je colle les formules dans la colonne cherchée (De xxx2 à xxx2001)

Pour faire plus correct vis à vis de ton code initial, remplace 2000 par 1999