Problème avec .Delete xlUp

Version imprimable

Bonjour

J'ai un souci avec mon code, merci de m'aiguiller

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
 
    Dim iLigFin3 As Integer
    Dim iLig3 As Integer
    Dim iEcr3 As Integer
 
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
 
 
    If Target.Count = 1 Then
        If Target.AddressLocal = "$B$1" Then
 
            iLigFin3 = Range("e" & Rows.Count).End(xlUp).Row
 
 
            If iLigFin3 >= 26 Then
                Range("e26:o39" & iLigFin3).ClearContents
            End If
 
            iEcr3 = 26
            iLigFin3 = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row
 
 
             For iLig3 = 2 To iLigFin
                If Sheets("Facturation_Détaillée").Range("A" & iLig3).Value = Target.Value Then
                    Range("e" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("at" & iLig3).Value
                    Range("j" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("au" & iLig3).Value
                    Range("k" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("av" & iLig3).Value
                    Range("n" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("ar" & iLig3).Value
                    Range("o" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("aw" & iLig3).Value
                    iEcr3 = iEcr3 + 1
                End If
            Next iLig3
 
            Sheets("Facture").Range("e26:o39").SpecialCells(xlCellTypeBlanks).Delete xlUp
 
        End If
  End If
 
 
 
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.DisplayStatusBar = True
 
 
End Sub

Mon soucis est que le contenu des cellules qui excède le range E26:O39 sont effacer

Merci de votre aide

Bonjour,

Sans analyser ton code dans le détail, il y a un souci dans ce bloc

Code:

1
2
3
4
 
  If iLigFin3 >= 26 Then
                Range("e26:o39" & iLigFin3).ClearContents
            End If

Devrait plutôt être

Code:

1
2
3
4
 
  If iLigFin3 >= 26 Then
                Range("e26:o" & iLigFin3).ClearContents
            End If

08/05/2020, 17h47
Gonteur

Merci mfoxy

cela cause une erreur d'exécution

" La méthode 'Range' de l'objet' Wooksheet' a échoué "
08/05/2020, 17h59
mfoxy
Re,

À vérifier dans ton code la valeur de ta variable dernière ligne

Indiqué la parentalite de ton range

Exemple :
Code:

1 2 Worksheets("Sheet1").Range("A1:G37").ClearContents
08/05/2020, 18h11
Gonteur

Merci mfoxy

J'ai le même résultat à l'exécution

Code:

Worksheets("Facture").Range("e26:o39").ClearContents
08/05/2020, 19h10
mfoxy

Re,

Assez bizarre ton truc, la ligne de code fournie fonctionne bien chez moi.

Tu es sur de ton nom de feuille ? (espace, Majuscule, ou autre ?)

Si tu veux bien, exprime en français ce que tu aimerais que la macro fasse au juste, c'est bien souvent plus simple à comprendre que de "lire" un code sans explications.

Avec printscreen, noms des feuilles,...

L'utilisation de tableau structuré est aussi un grand plus.

( au pire tu peux aussi poster ton classeur anonymiser, certain membre les ouvrent, mais pas tous)

Bat

Merci mfoxy

J'ai des données sur la feuille "Facturation Détaillée" dont la colonne "A" contient un numéro qui peut être répété sur plusieurs lignes

Je récupère sur la feuille "Facturation détaillée" les valeurs de plusieurs colonne se référant à la même valeur en "A" donc plusieurs lignes peuvent être retourné selon qu'elles aient la même valeur en "A"

Code:

1
2
3
If Target.Count = 1 Then
        If Target.AddressLocal = "$B$1" Then
            iLigFin3 = Range("e" & Rows.Count).End(xlUp).Row

Donc sur la feuille "Facture", pour toutes les lignes de la feuille "Facturation Détaillée" qui ont la valeur ciblé en "A"

E = AT de facturation détaillée
J = AU de facturation détaillée
K = AV de facturation détaillée
N = AR de facturation détaillée
O = AW de facturation détaillée

Code:

1
2
3
4
5
6
7
8
9
10
For iLig3 = 2 To iLigFin
                If Sheets("Facturation_Détaillée").Range("A" & iLig3).Value = Target.Value Then
                    Range("e" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("at" & iLig3).Value
                    Range("j" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("au" & iLig3).Value
                    Range("k" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("av" & iLig3).Value
                    Range("n" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("ar" & iLig3).Value
                    Range("o" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("aw" & iLig3).Value
                    iEcr3 = iEcr3 + 1
                End If
            Next iLig3

Considérant que certaines lignes de "Facturation Détaillée" qui ont la même valeur en A sont retournées vide pour les cellules E, J, K, N, O, j'exécute le code

Code:

Worksheets("Facture").Range("e26:o39").SpecialCells(xlCellTypeBlanks).Delete xlUp

Ce qui fonctionne bien, les cellules qui contiennent des valeurs s' alignent une à la suite de l'autre sans laisser de cellules vides

Losrque la valeur ciblée en A change, je vide les lignes avec le code

Code:

1
2
If iLigFin3 >= 26 Then
                  Worksheets("Facture").Range("e26:o39").ClearContents

Le problème est que le contenu des cellules se vident au delà de la ligne 39 mentionnée

Et voici le code complet

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim iLigFin As Integer
    Dim iLig As Integer
    Dim iEcr As Integer
    Dim iLigFin2 As Integer
    Dim iLig2 As Integer
    Dim iEcr2 As Integer
    Dim iLigFin3 As Integer
    Dim iLig3 As Integer
    Dim iEcr3 As Integer
    Dim start As Single
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
 
    'start = Timer
 
    If Target.Count = 1 Then
        If Target.AddressLocal = "$B$1" Then
            iLigFin = Range("a" & Rows.Count).End(xlUp).Row
            iLigFin2 = Range("b" & Rows.Count).End(xlUp).Row
            iLigFin3 = Range("e" & Rows.Count).End(xlUp).Row
 
            If iLigFin >= 3 Then
                Range("a3:a75" & iLigFin).ClearContents
            End If
 
            If iLigFin2 >= 26 Then
                Range("b26:d100" & iLigFin2).ClearContents
            End If
 
            If iLigFin3 >= 26 Then
                  Worksheets("Facture").Range("e26:o39").ClearContents
            End If
 
            iEcr = 7
            iLigFin = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row
 
            iEcr2 = 26
            iLigFin2 = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row
 
            iEcr3 = 26
            iLigFin3 = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row
 
            For iLig = 2 To iLigFin
                If Sheets("Facturation_Détaillée").Range("A" & iLig).Value = Target.Value Then
                    Range("A" & iEcr).Value = Sheets("Facturation_Détaillée").Range("G" & iLig).Value
                    Sheets("Facture").Range("a3:a75").RemoveDuplicates Columns:=1, Header:=xlNo
                    iEcr = iEcr + 1
 
                End If
            Next iLig
 
            For iLig2 = 2 To iLigFin2
                If Sheets("Facturation_Détaillée").Range("A" & iLig2).Value = Target.Value Then
                    Range("b" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("al" & iLig2).Value
                    Range("c" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("ak" & iLig2).Value
                    Range("d" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("aq" & iLig2).Value
 
                    iEcr2 = iEcr2 + 1
 
 
 
                    Worksheets("Facture").Range("b26:d100").SpecialCells(xlCellTypeBlanks).Delete xlUp
 
                End If
            Next iLig2
 
             For iLig3 = 2 To iLigFin
                If Sheets("Facturation_Détaillée").Range("A" & iLig3).Value = Target.Value Then
                    Range("e" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("at" & iLig3).Value
                    Range("j" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("au" & iLig3).Value
                    Range("k" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("av" & iLig3).Value
                    Range("n" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("ar" & iLig3).Value
                    Range("o" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("aw" & iLig3).Value
                    iEcr3 = iEcr3 + 1
                End If
            Next iLig3
 
            Worksheets("Facture").Range("e26:o39").SpecialCells(xlCellTypeBlanks).Delete xlUp
 
 
        End If
  End If
 
 
 
Application.ScreenUpdating = True
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.DisplayStatusBar = True
 
  'MsgBox "durée du traitement: " & Timer - start & " secondes"
End Sub

Voilà

08/05/2020, 21h03
Philippe Tulliez

Bonjour,
Lorsque l'on supprime des lignes dans une liste de données il faut partir de la dernière ligne vers la première.
Si tu supprimes manuellement une ligne, tu peux constater que celle-ci remonte.
08/05/2020, 21h43
Gonteur

Merci Philippe Tulliez

Je vais y arriver... Je crois savoir pourquoi, plutôt bête, les données au délà de la ligne 39 ne s’effaçaient pas, ils n'étaient pas générés à l'exécution du code donc vide...8O

J'y reviens bientôt

Bonjour

Comment modifier le code pour que si la valeur est nulle alors = "o"

Code:

1
2
3
4
5
6
7
8
9
10
For iLig3 = 2 To iLigFin3
                If Sheets("Facturation_Détaillée").Range("A" & iLig3).Value = Target.Value Then
                    Range("e" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("at" & iLig3).Value
                    Range("j" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("au" & iLig3).Value
                    Range("k" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("av" & iLig3).Value
                    Range("n" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("ar" & iLig3).Value
                    Range("o" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("aw" & iLig3).Value
                    iEcr3 = iEcr3 + 1
                End If
            Next iLig3

Merci

Bonjour

Mon code retourne maintenant tout ce que j'ai besoin :D

Je le joins pour ceux à qui ça pourrait servir

Merci de votre aide

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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim iLigFin As Integer
    Dim iLig As Integer
    Dim iEcr As Integer
    Dim iLigFin2 As Integer
    Dim iLig2 As Integer
    Dim iEcr2 As Integer
    Dim iLigFin3 As Integer
    Dim iLig3 As Integer
    Dim iEcr3 As Integer
    Dim iLigFin4 As Integer
    Dim iLig4 As Integer
    Dim iEcr4 As Integer
    Dim start As Single
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
 
    start = Timer
 
    If Target.Count = 1 Then
        If Target.AddressLocal = "$B$1" Then
            iLigFin = Range("a" & Rows.Count).End(xlUp).Row
            iLigFin2 = Range("b" & Rows.Count).End(xlUp).Row
            iLigFin3 = Range("e" & Rows.Count).End(xlUp).Row
            iLigFin4 = Range("e" & Rows.Count).End(xlUp).Row
 
            If iLigFin >= 3 Then
                Range("a3:a50" & iLigFin).ClearContents
            End If
 
            If iLigFin2 >= 26 Then
                Range("b26:d100" & iLigFin2).ClearContents
            End If
 
            If iLigFin3 >= 26 Then
                Range("e26:o38" & iLigFin3).ClearContents
            End If
 
            If iLigFin4 >= 41 Then
                Range("e41:o100" & iLigFin4).ClearContents
            End If
 
            iEcr = 7
            iLigFin = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row
 
            iEcr2 = 26
            iLigFin2 = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row
 
            iEcr3 = 26
            iLigFin3 = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row
 
            iEcr4 = 41
            iLigFin4 = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row
 
            For iLig = 2 To iLigFin
                If Sheets("Facturation_Détaillée").Range("A" & iLig).Value = Target.Value Then
                    Range("A" & iEcr).Value = Sheets("Facturation_Détaillée").Range("G" & iLig).Value
                    Sheets("Facture").Range("a3:a50").RemoveDuplicates Columns:=1, Header:=xlNo
                    iEcr = iEcr + 1
                End If
            Next iLig
 
            For iLig2 = 2 To iLigFin2
                If Sheets("Facturation_Détaillée").Range("A" & iLig2).Value = Target.Value Then
                    Range("b" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("al" & iLig2).Value
                    Range("c" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("ak" & iLig2).Value
                    Range("d" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("aq" & iLig2).Value
                    iEcr2 = iEcr2 + 1
                End If
            Next iLig2
 
             For iLig3 = 2 To iLigFin3
                If Sheets("Facturation_Détaillée").Range("A" & iLig3).Value = Target.Value Then
                    Range("e" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("at" & iLig3).Value
                    Range("j" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("au" & iLig3).Value
                    Range("k" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("av" & iLig3).Value
                    Range("n" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("ar" & iLig3).Value
                    Range("o" & iEcr3).Value = Sheets("Facturation_Détaillée").Range("aw" & iLig3).Value
                    iEcr3 = iEcr3 + 1
                End If
                 Next iLig3
 
           For iLig3 = 26 To 39
                If Range("E" & iLig3) <> "" And Range("j" & iLig3) = "" Then
                Range("j" & iLig3) = "x"
                Range("j" & iLig3).Font.Color = RGB(255, 255, 255)
                End If
            Next iLig3
 
    Worksheets("Facture").Range("E26:O40").SpecialCells(xlCellTypeBlanks).Delete xlUp
 
            Range("E40").Select
    ActiveCell.FormulaR1C1 = "Travaux particuliers"
 
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .ReadingOrder = xlContext
    End With
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
    End With
    Range("E40:O40").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .ReadingOrder = xlContext
    End With
    Selection.Merge
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
 
           For iLig4 = 2 To iLigFin4
                If Sheets("Facturation_Détaillée").Range("A" & iLig4).Value = Target.Value Then
                    Range("e" & iEcr4).Value = Sheets("Facturation_Détaillée").Range("az" & iLig4).Value
                    Range("n" & iEcr4).Value = Sheets("Facturation_Détaillée").Range("ay" & iLig4).Value
                    Range("o" & iEcr4).Value = Sheets("Facturation_Détaillée").Range("bc" & iLig4).Value
                    iEcr4 = iEcr4 + 1
                End If
            Next iLig4
 
        End If
  End If
 
Worksheets("Facture").Range("b26:d100").SpecialCells(xlCellTypeBlanks).Delete xlUp
Worksheets("Facture").Range("e41:o100").SpecialCells(xlCellTypeBlanks).Delete xlUp
 
    Range("B26:D100,e40:o100").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 9
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
 
    Range("B26:D100,E27:O39,e41:o100").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
 
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
    Range("C26:C100,J26:J39,J41:J100,N26:N39,N41:N100").Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With
 
    Range("E26:O39").Select
 
    With Selection.Font
        .Name = "Calibri"
        .Size = 8
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
 
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
 
    Range("B1").Select
 
  MsgBox "durée du traitement: " & Timer - start & " secondes"
End Sub