Raccourcir temps d'execution loop

Raccourcir temps d'execution loop [RESOLU]

Bonjour,

j'ai un petit code VBA qui me permet de mettre une valeur dans plusieurs cellules d'une colonne en fonction des valeurs des cellules d'une autre colonne au moment d'un clic :

le code vérife la position du clic puis va chercher dans l'autre colonne (colonne1) la valeur. il remonte jusqu'a ne plus trouver cette valeur, puis redesend en inserant la valeur désirer dans chacune des cellules de l'autre colonne.

Public Sub ajoutvaleur(ByVal Target As Range)
Dim valeur As Double
If Not Intersect(Target, Range("H3:H500")) Is Nothing Then
valeur = 1
Selection.Offset(0, -3).Range("A1").Select
Dim colonne1 As Integer
colonne1 = Selection.Value
Do While Selection.Value = colonne1
Selection.Offset(-1, 0).Range("A1").Select
Loop
Selection.Offset(1, 0).Range("A1").Select
Do While Selection.Value = colonne1
Selection.Offset(0, 3).Value = valeur
Selection.Offset(1, 0).Range("A1").Select
Loop
End If
End Sub

Le problème etant que c'est une opération longue et je suis sur qu'il y a un moyen plus simple de le faire, non ? 😉