Problème de code VBA

Version imprimable

Voila ma question est simple, j'ai écris ce premier code :

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
Sub Bouton1_Cliquer()
    
    Sheets("Data").Range("A4:S1000").Copy Destination:=Sheets("Trie Pareto").Range("A2")

    Sheets("Trie Pareto").Select
    For i = 1100 To 2 Step -1
    If Sheets("Trie Pareto").Range("D" & i).Value <> "Curative urgente" Then Rows(i).Delete
    Next i
    
    Dim M As Integer
    Dim L As Integer

    For L = 2 To Range("C2").End(xlDown).Row
    If Sheets("Trie Pareto").Cells(L, 3).Value <> "" Then
    M = L
    End If
    Next L
    
    Sheets("Trie Pareto").Range("C2:C" & L).Copy Destination:=Sheets("Calcul Pareto").Range("C2")
    Sheets("Trie Pareto").Range("E2:E" & L).Copy Destination:=Sheets("Calcul Pareto").Range("D2")
    Sheets("Trie Pareto").Range("I2:I" & L).Copy Destination:=Sheets("Calcul Pareto").Range("E2")
    Sheets("Trie Pareto").Range("J2:J" & L).Copy Destination:=Sheets("Calcul Pareto").Range("F2")
    Sheets("Trie Pareto").Range("Q2:Q" & L).Copy Destination:=Sheets("Calcul Pareto").Range("G2")
    
    Sheets("Calcul Pareto").Select
    
End Sub

Puis après j'ai modifié le code car la fonction en rouge dans le premier code étais super longue et j'ai donc fais ce code la :

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
Sub Bouton1_Cliquer()
    
    Sheets("Data").Range("A4:S1000").Copy Destination:=Sheets("Trie Pareto").Range("A4")
    
    Sheets("Trie Pareto").Range("A1").Value = "Type de maintenance"
    Sheets("Trie Pareto").Range("A2").Value = "Curative urgente"

    Sheets("Trie Pareto").Range("A3:S1000").AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Trie Pareto").Range("A1:A2"), _
    CopyToRange:=Sheets("Trie Pareto").Range("U3:AM3"), _
    Unique:=False

    Dim y As Integer
    Dim h As Integer

    For h = 4 To Range("W4").End(xlDown).Row
    If Sheets("Trie Pareto").Cells(h, 23).Value <> "" Then
    y = h
    End If
    Next h
    
    Sheets("Trie Pareto").Range("W4:W" & y).Copy Destination:=Sheets("Calcul Pareto").Range("C2")
    Sheets("Trie Pareto").Range("X4:X" & y).Copy Destination:=Sheets("Calcul Pareto").Range("D2")
    Sheets("Trie Pareto").Range("AC4:AC" & y).Copy Destination:=Sheets("Calcul Pareto").Range("E2")
    Sheets("Trie Pareto").Range("AD4:AD" & y).Copy Destination:=Sheets("Calcul Pareto").Range("F2")
    Sheets("Trie Pareto").Range("AK4:AK" & y).Copy Destination:=Sheets("Calcul Pareto").Range("G2")
    
    Sheets("Calcul Pareto").Select
    
End Sub

Or maintenant les lignes de code en bleu déconnent alors que celle du premier code fonctionnaient. Et je ne comprend pas pourquoi.
Merci de votre aide. ;)

22/08/2012, 11h25
Philippe Tulliez

Bonjour,
C'est peut-être tout simplement parce-que ta fenêtre active a changé depuis que tu as modifié ton code.

Code:

For h = 4 To Range("W4").End(xlDown).Row

Pour le VBA si tu ne précises pas la feuille et le classeur, il travaille sur la cellule de la feuille active, ce qui est logique.
Si tu dis à quelqu'un par téléphone ferme la porte de la pièce et que tu ne lui précises pas de quelle pièce il s'agit, il fermera la porte de la pièce dans laquelle il se trouve, en espérant qu'il n'y en ait pas deux :D
22/08/2012, 11h38
Kalteck

Erf merci :ccool:, pourtant j'ai cherché d’où pouvait venir le problème :oops:

Merci Corona

et tu peux faire du ménage :

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
 
Sub Bouton1_Cliquer()
With Sheets("Trie Pareto")
 
    Sheets("Data").Range("A4:S1000").Copy Destination:=.Range("A4")
 
    .Range("A1").Value = "Type de maintenance"
    .Range("A2").Value = "Curative urgente"
 
    .Range("A3:S1000").AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=.Range("A1:A2"), _
    CopyToRange:=.Range("U3:AM3"), _
    Unique:=False
 
    Dim y As Integer
    Dim h As Integer
 
    For h = 4 To Range("W4").End(xlDown).Row
        If .Cells(h, 23).Value <> "" Then
            y = h
        End If
    Next h
 
    .Range("W4:W" & y).Copy Destination:=Sheets("Calcul Pareto").Range("C2")
    .Range("X4:X" & y).Copy Destination:=Sheets("Calcul Pareto").Range("D2")
    .Range("AC4:AC" & y).Copy Destination:=Sheets("Calcul Pareto").Range("E2")
    .Range("AD4:AD" & y).Copy Destination:=Sheets("Calcul Pareto").Range("F2")
    .Range("AK4:AK" & y).Copy Destination:=Sheets("Calcul Pareto").Range("G2")
End With
 
Sheets("Calcul Pareto").Select
 
End Sub