Aide sur Worksheet_Change

Fermé

Tsafast Messages postés 4 Date d'inscription jeudi 2 mars 2017 Statut Membre Dernière intervention 8 mars 2017 - 2 mars 2017 à 02:12
Tsafast Messages postés 4 Date d'inscription jeudi 2 mars 2017 Statut Membre Dernière intervention 8 mars 2017 - 8 mars 2017 à 20:52

Bonjour à tous,

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

Merci.

A voir également:

Worksheet_change sur une cellule
Aller à la ligne dans une cellule excel - Guide
Verrouiller cellule excel - Guide
Excel cellule couleur si condition texte - Guide
Excel remplir automatiquement une cellule en fonction d'une autre ✓ - Forum Excel
Excel renvoyer la valeur d'une cellule en fonction d'une autre - Forum Logiciels

1 réponse

Réponse 1 / 1

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
Modifié par yg_be le 2/03/2017 à 10:53

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

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
3 mars 2017 à 08:34

Salut yg_be,

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...

Tsafast Messages postés 4 Date d'inscription jeudi 2 mars 2017 Statut Membre Dernière intervention 8 mars 2017 > pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024
5 mars 2017 à 17:37

Bonjour,

Je vous remercie pour vos réponses, je test et vous redonne des nouvelles.

Merci!
Fernand

Bonjour Pijaku,

Merci 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.

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744 > Tsafast Messages postés 4 Date d'inscription jeudi 2 mars 2017 Statut Membre Dernière intervention 8 mars 2017
8 mars 2017 à 08:21

Salut,

Dé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 + 1

par :

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

Salut,

Aucun problème, je te remercie pour ta réponse, je test et te redonne des nouvelles.

Discussions similaires

Excel si cellule contient texte alors...

Excel : colorer une cellule sous condition d'une autre ?

Formule Excel : "SI" une cellule contient un mot, alors ?

=Si la cellule A1 a du texte = B1 devient couleur

excel fractionner une cellule horizontalement

Discussions similaires

Newsletters