Problème ajout suppression de lignes.

**ericmicro** · 19/02/2014, 14h46

Bonjour,

Dans le classeur ci-joint, j'ai une macro qui historise dans la feuille "Histo_TRLT" les changement de "TRLT Total J/O" et "Date MAJ" effectué dans la feuille "Liste des onglets".

Le problème que je n'arrive pas à résoudre est le suivant:

Si dans la feuille "Liste des onglets" j'ai une ou plusieurs nouvelles lignes ou suppressions de lignes, j'aimerai recopier ou supprimer la/les lignes dans la feuille "Histo_TRLT".
Merci de votre aide.

ED

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Private Sub Worksheet_Activate()
 
 
    'définition des variables
    Dim histo As String
    Dim TRLThisto As Integer
    Dim i As Integer
    Dim j As Integer
    Dim Derncol As Integer
    Dim Derncoltitre As Integer
 
 
 
j = 2 'N° ligne Liste des onglets
i = 2 'N° ligne Histo TRLT
 
Do While Cells(i, 2) <> ""
 
'recherche de  la premiere colonne vide par ligne ds la feuille Histo_TRLT
Derncol = (Cells(i, Cells.Columns.Count).End(xlToLeft).Column) + 1
 
 
 
histo = Cells(i, 1).Value 'récupère la valeur "Référence" de la feuille histo
 
TRLThisto = Cells(i, Derncol - 2) 'récupère la derniere valeur TRLT de la feuille histo
'MsgBox (TRLThisto)
 
 
While Sheets("Liste des onglets").Cells(j, 1) <> "" ' parcours le tableau de la feuille Liste des onglets
 
    If Sheets("Liste des onglets").Cells(j, 1) = histo And Sheets("Liste des onglets").Cells(j, 3) <> TRLThisto Then 'ne recupere les données que si differentes
        Cells(i, Derncol) = Sheets("Liste des onglets").Cells(j, 3) 'renvoie le TRLT dans la cellule de la premiere colonne vide de la ligne active de la feuille "Histo_TRLT
        Cells(i, Derncol + 1) = CDate(Sheets("Liste des onglets").Cells(j, 7)) 'renvoie la date dans la cellule de la deuxieme colonne vide de la ligne active de la feuille "Histo_TRLT
    End If
 
 
j = j + 1
'DernLigneliste = Sheets("Liste des onglets").Range("A" & Rows.Count).End(xlUp).Row 'compte les lignes de la liste des onglets
 
Wend
j = 2
i = i + 1
Loop
 
   Derncoltitre = Sheets("Histo_TRLT").UsedRange.Columns.Count 'recherche numero de la premiere colonne vide de la premiere ligne sur la feuille Histo_TRLT pour coller les titres
    'MsgBox (Derncoltitre)
 
    'copier coller des titres des deux colonnes
Range(Cells(1, Sheets("Histo_TRLT").UsedRange.Columns.Count - 3), Cells(1, Sheets("Histo_TRLT").UsedRange.Columns.Count - 2)).Select
Selection.Copy
Range(Cells(1, Sheets("Histo_TRLT").UsedRange.Columns.Count - 1), Cells(1, Sheets("Histo_TRLT").UsedRange.Columns.Count)).Select
ActiveSheet.Paste
     Application.CutCopyMode = False 'enleve la surbrillance copier
 
     Columns.AutoFit 'largeur de colonnes auto
 
    Range("A2").Select
 
End Sub

**Phil'oche** · 19/02/2014, 15h31

Excel ne propose pas, par défaut, d'interception des évènements "ajout" ou "suppression de ligne"

Pour contourner le problème, une solution :
- Ajouter dans ta feuille "liste des onglets" 2 boutons "Ajout ligne" et "Suppression ligne" qui vont déclencher du code VBA que tu pourras exploiter comme tu veux,

**ericmicro** · 19/02/2014, 15h46

Merci de votre réponse,
Je pensais pas à un évènement " ajout" ou "suppression de ligne", mais plutôt a un comparatif des deux feuilles.
Si la référence n'existe pas dans la feuille "Histo_TRLT", mais existe dans la feuille "Liste des onglets" alors on recopie la ligne dans "Histo_TRLT".
Inversement, si la référence existe dans la feuille "Histo_TRLT", mais n'existe plus dans la feuille "Liste des onglets" alors on supprime la ligne dans "Histo_TRLT".

**keygen08** · 19/02/2014, 19h08

Bonsoir
Vous pensez bien, c'est ce que je fais avec le code ci-dessous : a adpater

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'masque les lignes dont les vacanciers sont masqué avec le n° de soin
dim L as range, r as integer 
'pour la plage suivante : je compte le nombre de ligne sinon a chaque ligne retiré c'est le brin ( la ligne 10 devenant 9....)
For R = 6 To Range("a1:a" & [c65000].End(xlUp).Row).Rows.Count
'je verifie que mon n° d'enregistrement est existant sur l'autre feuille
        Set L = Feuil62.Columns(4).Find(Cells(R, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
        If L Is Nothing Then
            If R >= 6 Then
'si ce n'est pas le cas, j'efface la ligne
            Rows(R).Delete 
            Else: Exit For
            End If
        End If
Next R

je fais ensuite la comparaison inverse afin d'ajouter les n° d'enregistrement manquants.
Je me serais bien essayé sur votre fichier mais je n'arrive pas a l'ouvrir.

**ericmicro** · 20/02/2014, 10h57

Bonjour,
Voici mon fichier avec la formule pour la suppression des lignes qui n'existent plus dans la feuille "Liste des onglets".

Problème je n'arrive pas à faire l'inverse, import dans la feuille "Histo_TRLT" des nouvelles lignes de la feuille "Liste des onglets".

Si l'un d'entre vous a un solution ...

Merci,

ED

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
Private Sub Worksheet_Activate()
 
 
    'définition des variables
    Dim histo As String
    Dim TRLThisto As Integer
    Dim i As Integer
    Dim j As Integer
    Dim Derncol As Integer
    Dim Derncoltitre As Integer
 
 
 
j = 2 'N° ligne Liste des onglets
i = 2 'N° ligne Histo TRLT
 
 'module suppression des lignes qui n'existent plus dans la feuille "Liste des onglets"
Dim l As Range, r As Integer
 
For r = 2 To Range("a2:a" & [c65000].End(xlUp).Row).Rows.Count
 
Set l = Feuil2.Columns(1).Find(Cells(r, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
 
If l Is Nothing Then
 
If r >= 2 Then
 
Rows(r).Delete
 
Else: Exit For
End If
End If
 
Next r
 
 
 
 
'module ajout des nouvelles colonnes TRLT et Date
 
Do While Cells(i, 2) <> ""
 
'recherche de  la premiere colonne vide par ligne ds la feuille Histo_TRLT
Derncol = (Cells(i, Cells.Columns.Count).End(xlToLeft).Column) + 1
 
 
 
histo = Cells(i, 1).Value 'récupère la valeur "Référence" de la feuille histo
 
TRLThisto = Cells(i, Derncol - 2) 'récupère la derniere valeur TRLT de la feuille histo
'MsgBox (TRLThisto)
 
 
While Sheets("Liste des onglets").Cells(j, 1) <> "" ' parcours le tableau de la feuille Liste des onglets
 
    If Sheets("Liste des onglets").Cells(j, 1) = histo And Sheets("Liste des onglets").Cells(j, 3) <> TRLThisto Then 'ne recupere les données que si differentes
        Cells(i, Derncol) = Sheets("Liste des onglets").Cells(j, 3) 'renvoie le TRLT dans la cellule de la premiere colonne vide de la ligne active de la feuille "Histo_TRLT
        Cells(i, Derncol + 1) = CDate(Sheets("Liste des onglets").Cells(j, 7)) 'renvoie la date dans la cellule de la deuxieme colonne vide de la ligne active de la feuille "Histo_TRLT
    End If
 
 
j = j + 1
'DernLigneliste = Sheets("Liste des onglets").Range("A" & Rows.Count).End(xlUp).Row 'compte les lignes de la liste des onglets
 
Wend
j = 2
i = i + 1
Loop
 
   Derncoltitre = Sheets("Histo_TRLT").UsedRange.Columns.Count 'recherche numero de la premiere colonne vide de la premiere ligne sur la feuille Histo_TRLT pour coller les titres
    'MsgBox (Derncoltitre)
 
    'copier coller des titres des deux colonnes
Range(Cells(1, Sheets("Histo_TRLT").UsedRange.Columns.Count - 3), Cells(1, Sheets("Histo_TRLT").UsedRange.Columns.Count - 2)).Select
Selection.Copy
Range(Cells(1, Sheets("Histo_TRLT").UsedRange.Columns.Count - 1), Cells(1, Sheets("Histo_TRLT").UsedRange.Columns.Count)).Select
ActiveSheet.Paste
     Application.CutCopyMode = False 'enleve la surbrillance copier
 
     Columns.AutoFit 'largeur de colonnes auto
 
    Range("A2").Select
 
End Sub

**keygen08** · 21/02/2014, 12h20

Bonjour, la suite

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
'module ajout des nouvelles colonnes TRLT et Date
With Sheets("trlt")
For r = 2 To .Range("a2:a" & .[c65000].End(xlUp).Row).Rows.Count
Set l = Columns(1).Find(Cells(r, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
If l Is Nothing Then
If r >= 2 Then
.Rows(r).Copy Rows(r).Insert
'j'ai choisi de copier la ligne de trlt dans liste onglets.
Else: Exit For
End If
End If
Next r

N'arrivant pas a ouvrir les fichiers joints, je n'ai pus réaliser de test.

Problème ajout suppression de lignes. [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager