ajouter une ligne automatiquement si tel cellule est remplie

**croky23** · 22/01/2011, 09h44

Bonjour le forum

J'ai un tableau avec par défaut 7 lignes à remplir.
Je désire si la dernière cellule (D10) est remplie qu'une ligne s'ajoute automatiquement apres la ligne A5
Pouvez vous svp m'aider à faire cela
tableau ci-joint
bonne journée Jean Luc

**Qwazerty** · 22/01/2011, 10h27

Salut
Il faudra toujours tenir compte de la cellule D10, ou de la dernière cellule vide du tableau de la colonne D?
Parce que si tu modifies D10, et que tu rajoutes une ligne après la ligne 5, du coup D10 devient D11.
++
Qwaz

**croky23** · 22/01/2011, 10h33

il faudra tjrs tenir compte de la cellule D10 mais je pensais lui définir un nom genre "fimaS1"
merci de ton aide

**Qwazerty** · 22/01/2011, 10h58

Salut
Donc si tu lui attribues un nom, le nom suivra la cellule donc a l'ajout de la ligne fimaS1 sera la cellule D11, plus D10.
De plus si on tient toujours compte de D10, une fois que tu auras saisie quelque chose dedans ... il ne sera plus vide.
Ou alors tu veux te servir de la dernière ligne pour saisir les valeurs qui seront ensuite mise dans la ligne que tu rajoutes ?
Dont y avoir quelque chose que je ne saisie pas dans ta demande

++
Qwaz

**croky23** · 22/01/2011, 11h08

Envoyé par Qwazerty

Ou alors tu veux te servir de la dernière ligne pour saisir les valeurs qui seront ensuite mise dans la ligne que tu rajoutes ?

OUI c bien ça je n'avais pas pensé à cette solution .c'est possible?

**Qwazerty** · 22/01/2011, 11h24

Salut
Essais comme cela si ça te convient

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("CellSaisi").Address Then
    'On ajoute une ligne en fin de colonne et on vide CellSaisie
    With Range("CellSaisie")
        Range(Cells(.Row, "C"), Cells(.Row, "H")).Insert
        .Offset(-1, 0).Value = .Value
        'On arrete la generation d'evenement pour ne pas faire un boucle infini...
        Application.EnableEvents = False
        .Value = ""
        Application.EnableEvents = True
        'On selectionne la cellule suivante
        .Offset(-1, 1).Select
    End With
End If
End Sub

Sache qu'il est aussi possible d'utiliser des UserForm, elle permette d'afficher une fenêtre avec des champs texte, listes déroulantes, .... et de mettre a jour ensuite les cellule correspondantes dans ton tableau.
++
Qwaz

**croky23** · 22/01/2011, 12h12

merci bcp pour ces réponses
j'ai plusieurs tableau à la suite (une vingtaine)
j'ai adapté ton code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("finluS1").Address Then
    'On ajoute une ligne en fin de colonne et on vide CellSaisie
    With Range("finluS1")
        Range(Cells(.Row, "C"), Cells(.Row, "X")).Insert
        .Offset(-1, 0).Value = .Value
        'On arrete la generation d'evenement pour ne pas faire un boucle infini...
        Application.EnableEvents = False
        .Value = ""
        Application.EnableEvents = True
        'On selectionne la cellule suivante
        .Offset(-1, 1).Select
    End With
End If
If Target.Address = Range("finmaS1").Address Then
     With Range("finmaS1")
        Range(Cells(.Row, "C"), Cells(.Row, "X")).Insert
        .Offset(-1, 0).Value = .Value
        Application.EnableEvents = False
        .Value = ""
        Application.EnableEvents = True
         .Offset(-1, 1).Select
    End With
End If
If Target.Address = Range("finmerS1").Address Then
     With Range("finmerS1")
        Range(Cells(.Row, "C"), Cells(.Row, "X")).Insert
        .Offset(-1, 0).Value = .Value
        Application.EnableEvents = False
        .Value = ""
        Application.EnableEvents = True
         .Offset(-1, 1).Select
    End With
End If
End Sub

voila pour 3 tableaux et ça marche
dois-je recopier le code pour chaque tableau ?

**Qwazerty** · 22/01/2011, 13h40

Salut
Pour mettre du code, utilise la balise Code, c'est le bouton # dans la barre d’édition du message.

Sinon pour ton code voila une solution

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TheName
Dim ListeCell As String
 
'Si plusieur cellule sont impacté par une modif
'Ou si la cellule n'est pas nommé on quite
On Error Resume Next
TheName = Target.Name.NameLocal
On Error GoTo 0
If (Target.Count > 1) Or IsEmpty(TheName) Then Exit Sub
 
'On defini les cellules sur lequelle on réagira
ListeCell = ",CellSaisi,CellSaisi2," 'bien garder ',' au début et a la fin de la chaine
 
'For Each TheName In Array("CellSaisi", "CellSaisi2")
If InStr(1, ListeCell, "," & Target.Name.NameLocal & ",") Then
    'If Target.Name = TheName Then
        'On ajoute une ligne en fin de colonne et on vide CellSaisie
        With Target
            'On arrete la generation d'evenement pour ne pas faire un boucle infini...
            Application.EnableEvents = False
            Range(Cells(.Row, "C"), Cells(.Row, "H")).Insert
            .Offset(-1, 0).Value = .Value
            .Value = ""
            Application.EnableEvents = True
            'On selectionne la cellule suivante
            .Offset(-1, 1).Select
        End With
        'Exit For
    'End If
'Next
End If
End Sub

Tu definis dans ListeCell le nom de toutes tes cellules nommées sur lequelles tu veux que le code soit activé.

++
Qwaz

**croky23** · 22/01/2011, 19h22

j'ai un problème avec le code cela ne fonctionne pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TheName
Dim ListeCell As String
 
'Si plusieur cellule sont impacté par une modif
'Ou si la cellule n'est pas nommé on quite
On Error Resume Next
TheName = Target.Name.NameLocal
On Error GoTo 0
If (Target.Count > 1) Or IsEmpty(TheName) Then Exit Sub
 
'On defini les cellules sur lequelle on réagira
ListeCell = ",finluS6,finmaS6," 'bien garder ',' au début et a la fin de la chaine
 
For Each TheName In Array("finluS6", "finmaS6")
If InStr(1, ListeCell, "," & Target.Name.NameLocal & ",") Then
    If Target.Name = TheName Then
        'On ajoute une ligne en fin de colonne et on vide CellSaisie
        With Target
            'On arrete la generation d'evenement pour ne pas faire un boucle infini...
            Application.EnableEvents = False
            Range(Cells(.Row, "C"), Cells(.Row, "X")).Insert
            .Offset(-1, 0).Value = .Value
            .Value = ""
            Application.EnableEvents = True
            'On selectionne la cellule suivante
            .Offset(-1, 1).Select
        End With
        Exit For
    End If
 
End If
Next
End Sub

**Qwazerty** · 22/01/2011, 19h27

Salut
Pourquoi avec activer des ligne que j'avais mis en commentaire ?
Le For... c’était un essai, donc faut laisser les '

++
Qwaz

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TheName
Dim ListeCell As String
 
'Si plusieur cellule sont impacté par une modif
'Ou si la cellule n'est pas nommé on quite
On Error Resume Next
TheName = Target.Name.NameLocal
On Error GoTo 0
If (Target.Count > 1) Or IsEmpty(TheName) Then Exit Sub
 
'On defini les cellules sur lequelle on réagira
ListeCell = ",finluS6,finmaS6," 'bien garder ',' au début et a la fin de la chaine
 
If InStr(1, ListeCell, "," & Target.Name.NameLocal & ",") Then
        'On ajoute une ligne en fin de colonne et on vide CellSaisie
        With Target
            'On arrete la generation d'evenement pour ne pas faire un boucle infini...
            Application.EnableEvents = False
            Range(Cells(.Row, "C"), Cells(.Row, "H")).Insert
            .Offset(-1, 0).Value = .Value
            .Value = ""
            Application.EnableEvents = True
            'On selectionne la cellule suivante
            .Offset(-1, 1).Select
        End With
        'Exit For
End If
End Sub

**croky23** · 22/01/2011, 19h32

voila le code que j'ai mis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TheName
Dim ListeCell As String
 
'Si plusieur cellule sont impacté par une modif
'Ou si la cellule n'est pas nommé on quite
On Error Resume Next
TheName = Target.Name.NameLocal
On Error GoTo 0
If (Target.Count > 1) Or IsEmpty(TheName) Then Exit Sub
 
'On defini les cellules sur lequelle on réagira
ListeCell = ",luS6,maS6," 'bien garder ',' au début et a la fin de la chaine
 
'For Each TheName In Array("luS6", "maS6")
If InStr(1, ListeCell, "," & Target.Name.NameLocal & ",") Then
    'If Target.Name = TheName Then
        'On ajoute une ligne en fin de colonne et on vide CellSaisie
        With Target
            'On arrete la generation d'evenement pour ne pas faire un boucle infini...
            Application.EnableEvents = False
            Range(Cells(.Row, "C"), Cells(.Row, "X")).Insert
            .Offset(-1, 0).Value = .Value
            .Value = ""
            Application.EnableEvents = True
            'On selectionne la cellule suivante
            .Offset(-1, 1).Select
        End With
        'Exit For
    'End If
'Next
End If
End Sub

mais cela ne me rajoute pas de ligne

**Qwazerty** · 22/01/2011, 19h34

Salut
Met voir ton fichier stp
++
Qwaz

**croky23** · 22/01/2011, 19h41

merci de m'aider
voici mon fichier

**Qwazerty** · 22/01/2011, 20h31

Alors
Les noms de cellule se retrouvent affublés du nom de la feuille, mais pas toujours... j'ai modifié pour éliminer le problème, veuille par contre, a ne pas avoir 2 noms de cellule identiques sur 2 feuilles différentes (vu les noms de tes étiquettes, je pense pas que ça pose de problème, vu qu'elles contiennent le n° de la semaine).
J'ai corrigé une erreur dans mon code également

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If InStr(1, ListeCell, "," & TheName & ",") Then

Je me suis permis de modifier un peu tes mises en formes conditionnelles sur ton 2eme tableau, j’espère que ça va passer, je suis en Excel 2007, normalement la mise en forme que j'ai changé est bateau et ça ne devrait pas poser de soucis.
++
Qwaz

**croky23** · 22/01/2011, 21h13

merci cela me parait parfait

bonne soirée

**croky23** · 23/01/2011, 15h33

re bonjour et bo,n dimanche
Pour continuer sur le même dossier , j'ai encore un petit soucis car dans la colonne H(masquée) j'ai une formule .et celle ci n'est pas dupliquée .
merci de votre aide
croky23

**Qwazerty** · 23/01/2011, 22h47

Salut

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TheName
Dim ListeCell As String
Dim Position
 
'Si plusieur cellule sont impacté par une modif
'Ou si la cellule n'est pas nommé on quite
On Error Resume Next
TheName = Target.Name.NameLocal
On Error GoTo 0
If (Target.Count > 1) Or IsEmpty(TheName) Then Exit Sub
 
'On supprime la reference a la semaine si elle est presente ('Fevrier'!)
TheName = Replace(TheName, "'" & Target.Worksheet.Name & "'!", "")
 
 
'On defini les cellules sur lequelle on réagira
ListeCell = ",luS6,maS6,merS6,jeuS6,venS6," 'bien garder ',' au début et a la fin de la chaine
 
'For Each TheName In Array("luS6", "maS6","merS6","jeuS6",venS6")
If InStr(1, ListeCell, "," & TheName & ",") Then
    With Target
        'On arrete la generation d'evenement pour ne pas faire un boucle infini...
        Application.EnableEvents = False
        Range(Cells(.Row, "C"), Cells(.Row, "X")).Insert
        .Offset(-1, 0).Value = .Value
        .Value = ""
        Application.EnableEvents = True
        With .Offset(-1, 1)
            .Select
            'On rajoute la formule en colonne H
            .Offset(0, 3).Formula = "=E" & .Row & "*F" & .Row
        End With
    End With
End If
End Sub

++
Qwaz

**croky23** · 23/01/2011, 23h19

merci bcp
croky23

ajouter une ligne automatiquement si tel cellule est remplie [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager