Code Worksheet Change - corrigez moi svp

Bonjour, encore une autre fois je m'adresse a vous pour avoir votre aide, et je vous remercie d'avance.

j'ai un code qui a comme tache de copie les fonctions sur certains cellule, mais j’aimerai que la copie s'effectue que sur une seule linge, par exemple si je change la cellule A20 , j'aimerai que les cellules de la linge 20 seront changer.
Pour ce code que j’utilise, a chaque fois que je change par exemple la cellule A20 toutes les linges se changent a leurs tours.
J’aimerai que ma question est claire et aussi que j'aurai de votre aide. Merci
Voila le code

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

Private Sub Worksheet_Change(ByVal Target As Range) Dim Fin As Long, i As Long If Target.Cells.Count = 1 Then Fin = Cells(Rows.Count, 1).End(xlUp).Row If Not Application.Intersect(Target, Range("A1:A" & Fin)) Is Nothing Then For i = 18 To Fin If Range("AI" & i) = "-" Then Exit For Else If Range("A" & i).Value <> "" Then Range("E3:ES3").Copy Range("E" & i) Rows(i).RowHeight = 14 End If End If Next i End If End If End Sub

---

Bonjour Si Hiacham,
Pas très bien compris, puisque tu boucle de la ligne 18 vers la fin.
Quand même, selon ma compréhension, ci joint proposition

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long If Target.Count = 1 Then If Target.Column = 1 And Target.Row > 3 Then i = Target.Row If Range("AI" & i) = "-" Then Exit Sub Else Application.EnableEvents = False 'gagner un petit chouia. Un appel de la sub en moins If Range("A" & i).Value <> "" Then Range("E3:ES3").Copy Range("E" & i) Rows(i).RowHeight = 14 Else Range("E" & i & ":ES" & i).ClearContents End If Application.EnableEvents = True End If End If End If End Sub

---

Remarque que Fin (dernière ligne) est définie au sein de la sub et de ce fait sans utilité, puisque elle sera définie même si une cellule est changé au delà de la plage initiale et prendra la valeur de la ligne de ladite cellule.

Salut hicham28 et le forum

Code:

---

J’aimerai que ma question est claire

---

Nous aussi, mais ce n'est pas le cas.
Ce que je crois comprendre, c'est que tu veux copier des cellules, sans que celles qui en dépendent soient modifiées.
Je ne comprends pas trop ton code, mais à chacun sa méthode...
Je pense que tu dois modifier la ligne

Code:

---

Range("E3:ES3").Copy Range("E" & i)

---

Là, tu copies les formules. Et le résultat d'une formule se met à jour à chaque calcul de la feuille.

Code:

---

1 2	Range("E3:ES3").Copy Range("E" & i).Range("E" & i).PasteSpecial xlPasteValuesAndNumberFormats

---

On ne copie que les valeurs (pas les formules) et les formats.
Mais ne comprenant pas ton problème, c'est dur d'aider.

Ton code est assez confus :

Code:

---

1 2	Fin = Cells(Rows.Count, 1).End(xlUp).Row If Not Application.Intersect(Target, Range("A1:A" & Fin)) Is Nothing

---

Si, quand la colonne A fini en A20, tu modifies la cellule A5000, Fin t'indiquera la ligne 5000. Donc, il suffit de mettre Range(A:A) ou columns(1) à la place de Range("A1:A" & Fin)

Code:

---

For i = 18 To Fin

---

Donc, on va refaire une manip de A18 à Ax (x étant la dernière de A). Moi, ce qui me gène, c'est qu'on peut avoir x<18 (mais ça, c'est sans doute dû à une méconnaissance du problème).

Code:

---

1 2	If Range("A" & i).Value <> "" Then Range("E3:ES3").Copy Range("E" & i)

---

Si je lis ton code : si A non vide (et différente de "-") alors copier E3:ES3 sur la ligne ???? Donc, tu veux copier les formules ?

Pour pouvoir aider il faut :
Le début (les données) et la fin (le résultat à obtenir)
éventuellement le code (la manière) à condition de donner son algorithme (ce qu'il est censé faire).
Et se poser la question suivante : Est-ce qu'il vaut mieux perdre du temps à rendre compréhensible mon problème dès le premier poste, ou attendre patiemment que quelqu'un se penche sur le poste et demande des précisions. Le premier temps va se chiffrer en heures (et je suis plus que large), le deuxième en jour (si et seulement si on a des réponses).
A+