J'aimerais bien si possible, une aide pour écrire un code qui pourrait me permettre d'automatiser ce qui suit.
je suis sur Excel 2003.
Voici le code que j'aimerais écrire, si quelqu’un peut me donner une piste de départ.
Merci à l'avance
Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I4:I46")) Is Nothing Then
if I5 change then
copy range(B5:F5) 'sur la dernière ligne vide disponible du tableau (B6:F6 en jaune)
retrait à gauche sur la cellule E6 'écrire résultat de la soutraction : E5 - I5 = 200
elseif
ainsi de suite jusqu'a I46
bonjour,
veux-tu commencer en I5 ou en I4?
je suggère de faire une boucle sur toutes les celulles de Intersect, et de faire le boulot pour chacune de ces cellules.
quelque chose comme:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellule As Range
Dim intersection As Range
Set intersection = Intersect(Target, Range("I4:I46"))
If Not intersection Is Nothing Then
For Each cellule In intersection
' faire le boulot pour la ligne de la cellule
Next cellule
End If
End Sub
Un For Each dans une procédure Change?
Dans ce cas ce n'est pas utile.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("I4:I46")) Is Nothing Then Exit Sub
Dim Ligne As Integer, DL As Integer
DL = Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row + 1
Ligne = Target.Row
Range("B" & Ligne & ":F" & Ligne).Copy Range("B" & DL)
End Sub
Je n'ai fait que la copie, reste à faire le calcul...
Premier souci:
la formule fonctionne bien mais j'aimerais si c'est possible qu'il s'en tienne qu'aux tableaux I4 à I46 car j'ai un autre tableau en dessous et il copie sur l'autre tableau. J'ai essayé ceci avant la copie mais il ne copie plus la ligne.
Range("B46"). End(xlUp). Offset(1, 0). Select.
Deuxième souci:
encore une fois si possible et ça je ne l'avais pas mentionné dans mon premier texte
Je voudrais qu'il copie la ligne seulement si la case qui est modifiée dans la rangée (I) est vide
DL = Range("B3").End(xlDown).Row + 1
If DL > 46 Then Exit Sub
Je voudrais qu'il copie la ligne seulement si la case qui est modifiée dans la rangée (I) est vide Remplacer :
Range("B" & Ligne & ":F" & Ligne).Copy Range("B" & DL)
Par :
If Range("I" & Ligne) = "" Then
Range("B" & Ligne & ":F" & Ligne).Copy Range("B" & DL)
End If
Soit :
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("I4:I46")) Is Nothing Then Exit Sub
Dim Ligne As Integer, DL As Integer
DL = Range("B3").End(xlDown).Row + 1
If DL > 46 Then Exit Sub
Ligne = Target.Row
If Range("I" & Ligne) = "" Then
Range("B" & Ligne & ":F" & Ligne).Copy Range("B" & DL)
End If
End Sub
- Messages postés
-
12251
- Date d'inscription
- jeudi 15 mai 2008
- Statut
- Modérateur
- Dernière intervention
- 17 mars 2021
2 591Un For Each dans une procédure Change?
Dans ce cas ce n'est pas utile.
Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("I4:I46")) Is Nothing Then Exit Sub Dim Ligne As Integer, DL As Integer DL = Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row + 1 Ligne = Target.Row Range("B" & Ligne & ":F" & Ligne).Copy Range("B" & DL) End SubJe n'ai fait que la copie, reste à faire le calcul...
- Messages postés
-
4
- Date d'inscription
- jeudi 2 mars 2017
- Statut
- Membre
- Dernière intervention
- 8 mars 2017
> pijakuJe vous remercie pour vos réponses, je test et vous redonne des nouvelles.
Merci!
Fernand
- Messages postés
-
4
- Date d'inscription
- jeudi 2 mars 2017
- Statut
- Membre
- Dernière intervention
- 8 mars 2017
> pijakuMerci pour ton aide qui est bien apprécié.
Premier souci:
la formule fonctionne bien mais j'aimerais si c'est possible qu'il s'en tienne qu'aux tableaux I4 à I46 car j'ai un autre tableau en dessous et il copie sur l'autre tableau. J'ai essayé ceci avant la copie mais il ne copie plus la ligne.
Range("B46"). End(xlUp). Offset(1, 0). Select.
Deuxième souci:
encore une fois si possible et ça je ne l'avais pas mentionné dans mon premier texte
Je voudrais qu'il copie la ligne seulement si la case qui est modifiée dans la rangée (I) est vide
Merci encore une fois pour ton aide.
- Messages postés
-
12251
- Date d'inscription
- jeudi 15 mai 2008
- Statut
- Modérateur
- Dernière intervention
- 17 mars 2021
2 591 > TsafastDésolé je n'avais pas vu ta réponse...
qu'il s'en tienne qu'aux tableaux I4 à I46
Dans mon code, remplacer :
DL = Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row + 1par :
DL = Range("B3").End(xlDown).Row + 1 If DL > 46 Then Exit SubJe voudrais qu'il copie la ligne seulement si la case qui est modifiée dans la rangée (I) est vide
Remplacer :
Range("B" & Ligne & ":F" & Ligne).Copy Range("B" & DL)Par :
If Range("I" & Ligne) = "" Then Range("B" & Ligne & ":F" & Ligne).Copy Range("B" & DL) End IfSoit :
Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("I4:I46")) Is Nothing Then Exit Sub Dim Ligne As Integer, DL As Integer DL = Range("B3").End(xlDown).Row + 1 If DL > 46 Then Exit Sub Ligne = Target.Row If Range("I" & Ligne) = "" Then Range("B" & Ligne & ":F" & Ligne).Copy Range("B" & DL) End If End Sub- Messages postés
-
4
- Date d'inscription
- jeudi 2 mars 2017
- Statut
- Membre
- Dernière intervention
- 8 mars 2017
> pijakuAucun problème, je te remercie pour ta réponse, je test et te redonne des nouvelles.