Erreur 1004 sur Delete

**ALEX80800** · 15/06/2015, 15h52

Bonjour,

Voici un code complet

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
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
207
208
209
210
211
212
213
214
215
Sub GL1()
 
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long, o As Long, x As Variant, y As Variant
Dim Trouve As Boolean
Dim Wb As Workbook
Dim Ws As Worksheet
Dim Ws1 As Worksheet
Dim rep As String
Dim MaPlage As Range
Dim MaPlage1 As Range
Dim MaPlage2 As Range
Dim nom As String
 
 
 On Error GoTo errorHandler
 
'**************************************************************************************************************
 
rep = InputBox("Par quel nom Commence le nom de votre fichier à importer?")
 
'***************************************************************************************************************
 
For Each Wb In Application.Workbooks
    If UCase(Wb.Name) Like UCase(Left(rep, 1)) & Mid(rep, 2, 40) & "*" _
    Or LCase(Wb.Name) Like LCase(Left(rep, 1)) & Mid(rep, 2, 40) & "*" Then
        Trouve = True
        Exit For
    End If
Next Wb
 
'****************************************************************************************************************
Application.ScreenUpdating = False
If Trouve Then
    Set Ws = Wb.Worksheets("NATURE")
 
 
 
 
 
    With Ws
    .Activate
'********************************************************************************************************************************
' S'assurer de mettre tous les filtres du TCD à "Tous"
'--------------------------------------------------------------------------------------------------------------------------------
 
        With Cells
        .Select
        .PivotTable.ClearAllFilters
 
        End With
 
 
'-------------------------------------------------------------------------------------------------------------------------------
'********************************************************************************************************************************
' Rechercher la cellule du "total général" du TCD pour en extraire les données
'-------------------------------------------------------------------------------------------------------------------------------
 
      Set MaPlage = Range("A1:A500")
 
 i = Application.WorksheetFunction.Match("Total général", MaPlage, 0)
 
     Set MaPlage1 = Range("A1:A15")
 j = Application.WorksheetFunction.Match("Somme de SOLDE", MaPlage1, 0) + 1
 
     Set MaPlage2 = Range("A" & j & ":R" & j & "")
 k = Application.WorksheetFunction.Match("total général", MaPlage2, 0)
 
 
 
    .Cells(i, k).Select
    .Application.DoubleClick
 
 
   m = ActiveSheet.Index
 
End With
 
Set Ws1 = Wb.Worksheets(m)
 
 
 
                        With Ws1
 
'****************************************************************************************************************
 
 
             o = .Cells(Ws.Rows.Count, 1).End(xlUp).Row
 
'-------------------------------------------------------------------------------------------------------------------------------
'********************************************************************************************************************************
' Si Base = Chaulnes suppression des éléments chaulnes MG
'-------------------------------------------------------------------------------------------------------------------------------
 
 
 
 
              If Ws1.Range("A2").Value = "LA031" Then
 
                .Range("L2:L" & o).Replace What:="704", Replacement:="", LookAt:=xlWhole
                .Range("L2:L" & o).Replace What:="032", Replacement:="", LookAt:=xlWhole
                .Range("L2:L" & o).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
              End If
 
'****************************************************************************************************************
 
             l = .Cells(Ws.Rows.Count, 1).End(xlUp).Row
 
              x = Application.Max(Range("H2:H" & l))
 
                        .Activate
                        Range("A1:T" & l).Select
                            Selection.Sort Key1:=Range("H1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
                            False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption3 _
                            :=xlSortNormal
 
  End With
 
Set MaPlage = Nothing
Set MaPlage1 = Nothing
Set MaPlage2 = Nothing
 
 
 
                With ThisWorkbook.Worksheets("BD")
                .Range("X1").Value = ""
                End With
 
 
 
                With ThisWorkbook.Worksheets("GLN")
 
 
                 n = .Cells(Ws.Rows.Count, 1).End(xlUp).Row
                 y = Application.Max(Range("Q2:Q" & n))
 
                If x < y Then
 
                MsgBox "L'intégration des données est antérieur aux données présentes"
 
                Else
 
 
 
                    .Activate
                        With Cells
                        .Select
                        .ClearContents
                        End With
 
                    .Range("A1").Select
                    .Range("M1:AF" & l).Value = Ws1.Range("A1:T" & l).Value
                    .Range("A1").Value = "MS"
                    .Range("A2:A" & l).Formula = "=INDEX(BD!$A:$I,MATCH(CONCATENATE(AC2,AA2),BD!$L:$L,0),1)"
                    .Range("B1").Value = "Code Synergie1"
                    .Range("B2:B" & l).Formula = "=INDEX(BD!$A:$I,MATCH(CONCATENATE(AC2,AA2),BD!$L:$L,0),2)"
                    .Range("C1").Value = "Code Synergie2"
                    .Range("C2:C" & l).Formula = "=INDEX(BD!$A:$I,MATCH(CONCATENATE(AC2,AA2),BD!$L:$L,0),3)"
                    .Range("D1").Value = "Code Synergie3"
                    .Range("D2:D" & l).Formula = "=INDEX(BD!$A:$I,MATCH(CONCATENATE(AC2,AA2),BD!$L:$L,0),4)"
                    .Range("E1").Value = "Code Synergie4"
                    .Range("E2:E" & l).Formula = "=INDEX(BD!$A:$I,MATCH(CONCATENATE(AC2,AA2),BD!$L:$L,0),5)"
                    .Range("F1").Value = "Code Synergie5"
                    .Range("F2:F" & l).Formula = "=INDEX(BD!$A:$I,MATCH(CONCATENATE(AC2,AA2),BD!$L:$L,0),6)"
                    .Range("G1").Value = "Code Synergie6"
                    .Range("G2:G" & l).Formula = "=INDEX(BD!$A:$I,MATCH(CONCATENATE(AC2,AA2),BD!$L:$L,0),7)"
                    .Range("H1").Value = "Code Synergie7"
                    .Range("H2:H" & l).Formula = "=INDEX(BD!$A:$I,MATCH(CONCATENATE(AC2,AA2),BD!$L:$L,0),8)"
                    .Range("I1").Value = "Service0"
                    .Range("I2:I" & l).Formula = "=IFERROR(VLOOKUP(V2,BD!$M:$Q,2,FALSE),0)"
                    .Range("J1").Value = "Service1"
                    .Range("J2:J" & l).Formula = "=IFERROR(VLOOKUP(V2,BD!$M:$Q,3,FALSE),0)"
                    .Range("K1").Value = "Service2"
                    .Range("K2:K" & l).Formula = "=IFERROR(VLOOKUP(V2,BD!$M:$Q,4,FALSE),0)"
                    .Range("L1").Value = "FIX/VAR"
                    .Range("L2:L" & l).Formula = "=IFERROR(VLOOKUP(V2,BD!$M:$Q,5,FALSE),0)"
                    .Columns("A:L").Copy
                    .Columns("A:L").PasteSpecial xlPasteValues
                                Application.CutCopyMode = Fals
 
                    End If
 
 
                End With
 
                With ThisWorkbook.Worksheets("Sommaire")
                .Activate
                .Range("L68").Select
                End With
 
 
 
 
Application.ScreenUpdating = True
 
 
        Else
        MsgBox "L'importation des données que vous essayez d'effectuer ne peut être effectuée pour l'une des 3 raisons :" _
        & vbCrLf & vbCrLf & "1 - Le fichier " & rep & "xxx n'est pas ouvert" & vbCrLf & _
        "2 - Le fichier a un nom diffèrent de " & rep & "xxx" & vbCrLf & _
        "3 - Vous avez ouvert l'application Excel plusieurs fois - N'en ouvrir qu'une seule"
 
        'Etape de Libération d'espace mémoire sur  Ws et Wb
            Set Ws = Nothing
            Set Ws1 = Nothing
            Set Wb = Nothing
        'Correspond au End If de If trouve
        End If
    Exit Sub
 
errorHandler:
 
    MsgBox "Erreur sur le code macro" & vbCrLf & _
        "Ou vous avez validé sans mettre de lettres" & vbCrLf & _
        "Veuillez informer le concepteur du code pour résolution"
End Sub

Mais pour situer mon anomalie je vous cible l'erreur. Ce code fonctionnait bien jusqu'à un changement de support.

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
   o = .Cells(Ws.Rows.Count, 1).End(xlUp).Row
 
'-------------------------------------------------------------------------------------------------------------------------------
'********************************************************************************************************************************
' Si Base = Chaulnes suppression des éléments chaulnes MG
'-------------------------------------------------------------------------------------------------------------------------------
 
 
 
 
              If Ws1.Range("A2").Value = "LA031" Then
 
                .Range("L2:L" & o).Replace What:="704", Replacement:="", LookAt:=xlWhole
                .Range("L2:L" & o).Replace What:="032", Replacement:="", LookAt:=xlWhole
                .Range("L1:L" & o).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
              End If

Le code met bien à blanc les valeurs "704" & "032" mais bloque sur la suppression des lignes vides.
J'ai même essayé .Range("L:L") .Columns("L")
Mais rien n' y fait

Merci de votre aide

**lionel86500** · 15/06/2015, 15h56

Bonjour,

si ta version Excel est 2003 ou moins, cela arrive avec un trop grand nombre de traitement identique.
j'ai rencontré ce problème avec la création de feuille via une macro.

**ALEX80800** · 15/06/2015, 16h07

Lionel,

J'ai bien une version 2007.
Mais le fichier support est une reprise d'un classeur 97-2003 converti en xlsx.
Est ce que ça peut jouer?

**lionel86500** · 15/06/2015, 16h13

Re bonjour

Normalement non

Erreur 1004 sur Delete [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager