Delete de row entre deux row renommées

Version imprimable

Bonjour à toutes et à tous,

Je rencontre un problème pour effacer les lignes que je génère avec le code ci-dessous.
Une ligne est créée en fonction de la ldatewish1value(bsum).
Mon problème est qu’une fois ces lignes créées je souhaiterais faire un delete sur les lignes qui ont été ajoutées.
J’ai voulu essayer de nommer les lignes pour faire un delete entre deux lignes mais il se trouve que ma ligne se décale et perd le nom que je lui ai passé.
Pouvez-vous m’aider ou m’indiquer si une solution plus simple existe ?

Code:

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
 
On Error GoTo passealasuite
nbre_mois = ((Year(Date) - Year(ldatewish1value(bsum))) * 12) + Month(Date) - Month(ldatewish1value(bsum))
nbre_mois = nbre_mois
On Error GoTo passealasuite
 
    If lsummary1value(bsum) = Empty Or lsummary1value(bsum) = "" Then lsummary1value(bsum) = " -- "
    If lTeam1value(bsum) = Empty Or lTeam1value(bsum) = "" Then lTeam1value(bsum) = " -- "
    If lresponsible1value(bsum) = Empty Or lresponsible1value(bsum) = " " Then lresponsible1value(bsum) = " -- "
    If ldatewish1value(bsum) = Empty Or ldatewish1value(bsum) = "" Then ldatewish1value(bsum) = " -- "
    If lstatus1value(bsum) = Empty Or lstatus1value(bsum) = "" Then lstatus1value(bsum) = " -- "
 
    If ldatewish1value(bsum) = " -- " Then GoTo dt 'pas de date wish goto <1 mois
 
    If nbre_mois < 1 Then
dt:
        Application.ScreenUpdating = False
        Sheet9.Activate
        Sheet9.range("Actionplan1").Offset(1, 0).Select
        Selection.Insert
        Sheet9.range("Actionplan1").Select
        Selection.Copy
        Sheet9.range("Actionplan1").Offset(1, 0).Select
        ActiveSheet.Paste
 
               Sheet9.range("shorttermactions1").Offset(1) = lsummary1value(bsum)
               Sheet9.range("shorttermteam1").Offset(1) = lTeam1value(bsum)
               Sheet9.range("shorttermresponsible1").Offset(1) = lresponsible1value(bsum)
               Sheet9.range("shorttermduedate1").Offset(1) = ldatewish1value(bsum)
               Sheet9.range("shorttermstatus1").Offset(1) = lstatus1value(bsum)
 
             Application.ScreenUpdating = False
            GoTo passealasuite
 
     ElseIf nbre_mois >= 1 And nbre_mois < 3 Then
 
        Application.ScreenUpdating = False
        Sheet9.Activate
        Sheet9.range("Actionplan2").Offset(1, 0).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheet9.range("Actionplan2").Select
        Selection.Copy
        Sheet9.range("Actionplan2").Offset(1, 0).Select
        ActiveSheet.Paste
 
               Sheet9.range("mediumtermactions1").Offset(1) = lsummary1value(bsum)
               Sheet9.range("mediumtermteam1").Offset(1) = lTeam1value(bsum)
               Sheet9.range("mediumtermresponsible1").Offset(1) = lresponsible1value(bsum)
               Sheet9.range("mediumtermduedate1").Offset(1) = ldatewish1value(bsum)
               Sheet9.range("mediumtermstatus1").Offset(1) = lstatus1value(bsum)
 
             Application.ScreenUpdating = False
            GoTo passealasuite
 
    ElseIf nbre_mois >= 3 Then
 
        Application.ScreenUpdating = False
        Sheet9.Activate
        Sheet9.range("Actionplan3").Offset(1, 0).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheet9.range("Actionplan3").Select
        Selection.Copy
        Sheet9.range("Actionplan3").Offset(1, 0).Select
        ActiveSheet.Paste
 
               Sheet9.range("longtermactions1").Offset(1) = lsummary1value(bsum)
               Sheet9.range("longtermteam1").Offset(1) = lTeam1value(bsum)
               Sheet9.range("longtermresponsible1").Offset(1) = lresponsible1value(bsum)
               Sheet9.range("longtermduedate1").Offset(1) = ldatewish1value(bsum)
               Sheet9.range("longtermstatus1").Offset(1) = lstatus1value(bsum)
 
             Application.ScreenUpdating = False
            GoTo passealasuite
 
     End If 'fin de la condition date
passealasuite:

09/09/2011, 19h31
jfontaine

Bonjour,

Citation:

Mon problème est qu’une fois ces lignes créées je souhaiterais faire un delete sur les lignes qui ont été ajoutées.

tu ajoutes des lignes que tu supprimes ensuite :calim2::calim2:
Une idée à creuser, lors de l'ajout de ligne, tu mets un 1 dans la derni-re colonne de ta ligne.
Ensuite tu supprimes les lignes qui ont ce 1 dans la dernière colonne
14/09/2011, 15h55
nocontrol

Salut et merci de ta réponse, ca devrait fonctionner avec ca :).
Enfait je mets des informations dans les lignes que j'ajoute puis j'envoie le tout sur Word et pour finir je reset mon "template"

Hello,

J’ai un peu galéré mais c’est bon le code marche.

Pour delete les lignes ajoutées il suffira d’aller chercher dans la colonne ou on insert les valeurs les lignes contenant cette valeur.

Code:

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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
 
Dim bsum As Integer, lRowType(15), lrowtypeValue(15), Summary1(15), lsummary1value(15), _
                     lTeam1(15), lTeam1value(15), lresponsible1(15), lresponsible1value(15), _
                     ldatewish1(15), ldatewish1value(15), lstatus1(15), lstatus1value(15), ltest(15)
 
Dim bsum2 As Integer, ltest2(15)
Dim bsum3 As Integer, ltest3(15)
bsum2 = 1
bsum3 = 1
      For bsum = 1 To 15
 
    Sheet1.Activate
    lRowType(bsum) = ActiveSheet.range("COL_ROWTYPE").Column
    lrowtypeValue(bsum) = ActiveSheet.range(Number2Char(lRowType(bsum)) & lrow + bsum).Value
 
ltest(bsum) = "rowadelete"  'Variable qui va ajouter "rowadelete" dans la column "rowdelete"
ltest2(bsum2) = "rowadelete"
ltest3(bsum3) = "rowadelete"
 
If lrowtypeValue(bsum) <> "P" Then
 
    Summary1(bsum) = ActiveSheet.range("COL_Summary").Column
    lsummary1value(bsum) = ActiveSheet.range(Number2Char(Summary1(bsum)) & lrow + bsum).Value
    lTeam1(bsum) = ActiveSheet.range("COL_ASSIGNEE_DEPT").Column
    lTeam1value(bsum) = ActiveSheet.range(Number2Char(lTeam1(bsum)) & lrow + bsum).Value
    lresponsible1(bsum) = ActiveSheet.range("COL_ASSIGNEE").Column
    lresponsible1value(bsum) = ActiveSheet.range(Number2Char(lresponsible1(bsum)) & lrow + bsum).Value
    ldatewish1(bsum) = ActiveSheet.range("COL_WISHDATE").Column
    ldatewish1value(bsum) = ActiveSheet.range(Number2Char(ldatewish1(bsum)) & lrow + bsum).Value
    lstatus1(bsum) = ActiveSheet.range("COL_STATUS").Column
    lstatus1value(bsum) = ActiveSheet.range(Number2Char(lstatus1(bsum)) & lrow + bsum).Value
 
On Error GoTo passealasuite
nbre_mois = ((Year(Date) - Year(ldatewish1value(bsum))) * 12) + Month(Date) - Month(ldatewish1value(bsum))
nbre_mois = nbre_mois
On Error GoTo passealasuite
 
    If lsummary1value(bsum) = Empty Or lsummary1value(bsum) = "" Then lsummary1value(bsum) = " -- "
    If lTeam1value(bsum) = Empty Or lTeam1value(bsum) = "" Then lTeam1value(bsum) = " -- "
    If lresponsible1value(bsum) = Empty Or lresponsible1value(bsum) = "" Then lresponsible1value(bsum) = " -- "
    If ldatewish1value(bsum) = Empty Or ldatewish1value(bsum) = "" Then ldatewish1value(bsum) = " -- "
    If lstatus1value(bsum) = Empty Or lstatus1value(bsum) = "" Then lstatus1value(bsum) = " -- "
 
    If ldatewish1value(bsum) = " -- " Then GoTo dt 'pas de date wish goto <1 mois
 
    If nbre_mois < 1 Then
dt:
        Application.ScreenUpdating = False
        Sheet9.Activate
        Sheet9.range("Actionplan1").Offset(1, 0).Select
        Selection.Insert
        Sheet9.range("Actionplan1").Select
        Selection.Copy
        Sheet9.range("Actionplan1").Offset(1, 0).Select
        ActiveSheet.Paste
 
               Sheet9.range("shorttermactions1").Offset(1) = lsummary1value(bsum)
               Sheet9.range("shorttermteam1").Offset(1) = lTeam1value(bsum)
               Sheet9.range("shorttermresponsible1").Offset(1) = lresponsible1value(bsum)
               Sheet9.range("shorttermduedate1").Offset(1) = ldatewish1value(bsum)
               Sheet9.range("shorttermstatus1").Offset(1) = lstatus1value(bsum)
               Sheet9.range("shorttermstatus1").Offset((bsum), 3) = ltest(bsum) ' ligne qui ajoute le text "rowadelete" dans la column "rowdelete"
 
             Application.ScreenUpdating = False
            GoTo passealasuite
 
     ElseIf nbre_mois >= 1 And nbre_mois < 3 Then
 
        Application.ScreenUpdating = False
        Sheet9.Activate
        Sheet9.range("Actionplan2").Offset(1, 0).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheet9.range("Actionplan2").Select
        Selection.Copy
        Sheet9.range("Actionplan2").Offset(1, 0).Select
        ActiveSheet.Paste
 
    ltest2(bsum2) = "rowadelete"
 
               Sheet9.range("shorttermactions2").Offset(1) = lsummary1value(bsum)
               Sheet9.range("shorttermteam2").Offset(1) = lTeam1value(bsum)
               Sheet9.range("shorttermresponsible2").Offset(1) = lresponsible1value(bsum)
               Sheet9.range("shorttermduedate2").Offset(1) = ldatewish1value(bsum)
               Sheet9.range("shorttermstatus2").Offset(1) = lstatus1value(bsum)
               Sheet9.range("shorttermstatus2").Offset((bsum2), 3) = ltest2(bsum2)  ' ligne qui ajoute le text "rowadelete" dans la column "rowdelete"
               bsum2 = bsum2 + 1
 
             Application.ScreenUpdating = False
            GoTo passealasuite
 
    ElseIf nbre_mois >= 3 Then
 
        Application.ScreenUpdating = False
        Sheet9.Activate
        Sheet9.range("Actionplan3").Offset(1, 0).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheet9.range("Actionplan3").Select
        Selection.Copy
        Sheet9.range("Actionplan3").Offset(1, 0).Select
        ActiveSheet.Paste
 
    ltest3(bsum3) = "rowadelete"
 
               Sheet9.range("shorttermactions3").Offset(1) = lsummary1value(bsum)
               Sheet9.range("shorttermteam3").Offset(1) = lTeam1value(bsum)
               Sheet9.range("shorttermresponsible3").Offset(1) = lresponsible1value(bsum)
               Sheet9.range("shorttermduedate3").Offset(1) = ldatewish1value(bsum)
               Sheet9.range("shorttermstatus3").Offset(1) = lstatus1value(bsum)
               Sheet9.range("shorttermstatus3").Offset((bsum3), 3) = ltest3(bsum3) ' ligne qui ajoute le text "rowadelete" dans la column "rowdelete"
               bsum3 = bsum3 + 1
 
             Application.ScreenUpdating = False
            GoTo passealasuite
 
     End If 'fin de la condition date
passealasuite:
 
Else    ' si lrowtypeValue(bsum) = "P"
            lsummary1value(bsum) = ""
            lTeam1value(bsum) = ""
            lresponsible1value(bsum) = ""
            ldatewish1value(bsum) = ""
            lstatus1value(bsum) = ""
 
            GoTo lasuite
 
End If
Next bsum
 
lasuite: