Discussion :

[Mapokko]

Salut,
Je travail sur Excel 2003 , pour remplir ma "Liste 1 " appartir de la "Base A" ,en inscrivant l'Année Scolaire dans la cellule de saisie"H5" ,j'ai fais le code suivant qui fonction bien . Mais peut- on simplifier l'écriture de code?

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, y As Integer
 
If (Target.Address = "$H$5") And Not IsEmpty(Target.Value) Then
    With Application.ThisWorkbook
        .Sheets("Liste1").Range("A9:I65000").ClearContents
 
        x = 3
        y = 8
 
        While (Sheets("Base A").Range("H" & x) <> "")
            If Sheets("Base A").Range("H" & x).Value = Sheets("Liste1").Range("H5").Value Then
                Sheets("Liste1").Range("A" & y).Value = Sheets("Base A").Range("A" & x).Value
                Sheets("Liste1").Range("B" & y).Value = Sheets("Base A").Range("B" & x).Value
                Sheets("Liste1").Range("C" & y).Value = Sheets("Base A").Range("C" & x).Value
                Sheets("Liste1").Range("D" & y).Value = Sheets("Base A").Range("D" & x).Value
                Sheets("Liste1").Range("E" & y).Value = Sheets("Base A").Range("E" & x).Value
                Sheets("Liste1").Range("F" & y).Value = Sheets("Base A").Range("F" & x).Value
                Sheets("Liste1").Range("G" & y).Value = Sheets("Base A").Range("G" & x).Value
                Sheets("Liste1").Range("H" & y).Value = Sheets("Base A").Range("I" & x).Value
                Sheets("Liste1").Range("I" & y).Value = Sheets("Base A").Range("J" & x).Value
                y = y + 1
            End If
 
            x = x + 1
        Wend
 
    End With
 
z = 8
While (Sheets("Liste1").Range("A" & z) <> "")
    z = z + 1
Wend
 
Sheets("Liste1").Select
Range("A8:I" & z).Select
 
Selection.Sort Key1:=Range("A8"), Order1:=xlAscending, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
End If
 
End Sub

Merci.
Cordialement

[Qwazerty]

SAlut

2 choses me sautent a l'oeil.

Pourquoi avoir gardé les 2 select en fin de code, il faut les intégré sur 1 seule ligne comme pour le reste de ton code

Code :

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

1
2
Sheets("Liste1").Range("A8:I" & z).Sort Key1:=Range("A8"), Order1:=xlAscending, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

La 2eme c'est cette partie

Code :

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

1
2
3
4
5
6
7
8
9
Sheets("Liste1").Range("A" & y).Value = Sheets("Base A").Range("A" & x).Value
                Sheets("Liste1").Range("B" & y).Value = Sheets("Base A").Range("B" & x).Value
                Sheets("Liste1").Range("C" & y).Value = Sheets("Base A").Range("C" & x).Value
                Sheets("Liste1").Range("D" & y).Value = Sheets("Base A").Range("D" & x).Value
                Sheets("Liste1").Range("E" & y).Value = Sheets("Base A").Range("E" & x).Value
                Sheets("Liste1").Range("F" & y).Value = Sheets("Base A").Range("F" & x).Value
                Sheets("Liste1").Range("G" & y).Value = Sheets("Base A").Range("G" & x).Value
                Sheets("Liste1").Range("H" & y).Value = Sheets("Base A").Range("I" & x).Value
                Sheets("Liste1").Range("I" & y).Value = Sheets("Base A").Range("J" & x).Value

Pourquoi ne pas faire la copie de toute les cellule d'un coup
(L'utilisation de With ici alégeré ton code)

Code :

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

1
2
3
With Sheets("Liste1")
  .range(.cells(y,"A"),.cells(y,"I")).value = Sheets("Base A").range(Sheets("Base A").cells(x,"A"),Sheets("Base A").cells(x,"I")).value
End With

[Edit]Correction du code[/Edit]Tu peux utiliser Copy aussi si ca te dis

[Edit]
Ho une 3eme
le

Code :

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

With Application.ThisWorkbook

est inutile, puisque tu es dans le code événementiel du thisworkbook, donc c pas la peine de le re-précisé.

Et de 4

Code :

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

1
2
3
4
z = 8
While (Sheets("Liste1").Range("A" & z) <> "")
    z = z + 1
Wend

si c'est pour trouver la derniere ligne non vide c'est comme ca

Code :

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

z = Sheets("Liste1").cells(rows.count,"A").End(Xlup).Row

[/Edit]
A++
Qwaz

[Mapokko]

Merci , c'est très gentil de ta part si tu m'écris le code final.
Cordialement

[Qwazerty]

Salut
Heuu, je veux pas faire le vieux rabat joie, mais on est dans un forum d'entraide certes, mais bon la je t'ai quand même grandement mâché le travail, un peu d'investissement, essais par toi même de modifier ton code en fonction de mes remarques, si tu as put pondre un tel code, ce ne devrait pas etre un soucis, reposte le une fois fait et s'il faut y apporter des corrections je te dirais ca
A++
Qwaz

[Mapokko]

Jai suivi tes conseils ,mais seulement avec cette partie du code que j'ai le problème.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
If Sheets("Base A").Range("H" & x).Value = Sheets("Liste1").Range("H5").Value Then
                Sheets("Liste1").Range("A" & y).Value = Sheets("Base A").Range("A" & x).Value
                Sheets("Liste1").Range("B" & y).Value = Sheets("Base A").Range("B" & x).Value
                Sheets("Liste1").Range("C" & y).Value = Sheets("Base A").Range("C" & x).Value
                Sheets("Liste1").Range("D" & y).Value = Sheets("Base A").Range("D" & x).Value
                Sheets("Liste1").Range("E" & y).Value = Sheets("Base A").Range("E" & x).Value
                Sheets("Liste1").Range("F" & y).Value = Sheets("Base A").Range("F" & x).Value
                Sheets("Liste1").Range("G" & y).Value = Sheets("Base A").Range("G" & x).Value
                Sheets("Liste1").Range("H" & y).Value = Sheets("Base A").Range("I" & x).Value
                Sheets("Liste1").Range("I" & y).Value = Sheets("Base A").Range("J" & x).Value
                y = y + 1
            End If

pour le reste ça va pas de problème.

Merci
Cordialement

[casefayere]

Bonjour qwaz, Mappoko, le forum

Qwaz, excuses-moi je ne veux pas interférer
Mappoko => Qwaz t'a maché le travail,

ton code :

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, y As Integer
 
If (Target.Address = "$H$5") And Not IsEmpty(Target.Value) Then
    With Application.ThisWorkbook
        .Sheets("Liste1").Range("A9:I65000").ClearContents
 
        x = 3
        y = 8
 
        While (Sheets("Base A").Range("H" & x) <> "")
            If Sheets("Base A").Range("H" & x).Value = Sheets("Liste1").Range("H5").Value Then
        With Sheets("Liste1")
            .Range(.Cells(y, "A"), .Cells(y, "I")) = Sheets("Base A").Range(Cells(x, "A"), Cells(x, "I"))
        End With
                y = y + 1
            End If         
            x = x + 1
        Wend  
    End With
Z = 8
While (Sheets("Liste1").Range("A" & Z) <> "")
    Z = Z + 1
Wend
Sheets("Liste1").Range("A8:I" & Z).Sort Key1:=Range("A8"), Order1:=xlAscending, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub