Création de Boucles VBA avec plusieurs Conditions

Version imprimable

Bonjour à tous,

je travaille actuellement sur une macro où je suis amené à aller chercher des valeurs dans une feuille pour les copier dans une autre.

Dans ma feuille "Vente" j'ai un filtre afin de pouvoir trier les données en fonction de ce que je recherche.
Ma cellule T3 calcule le sous total de la colonne T.
Puis je copie cette valeur dans une feuille client dans une cellule spécifique.

Ex de mon 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 28 29 30 31 32 Sheets("VENTE").Select Range("Q5").Select Selection.AutoFilter Selection.AutoFilter Field:=17, Criteria1:="Wave" Selection.AutoFilter Field:=7, Criteria1:="EL04" Selection.AutoFilter Field:=3, Criteria1:="1" Selection.AutoFilter Field:=5, Criteria1:="7" Range("T3").Select Selection.Copy Sheets("Elster Metering Limited").Select Range("E37").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("VENTE").Select Selection.AutoFilter Field:=5, Criteria1:="8" Range("T3").Select Selection.Copy Sheets("Elster Metering Limited").Select Range("F37").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("VENTE").Select Selection.AutoFilter Field:=5, Criteria1:="9" Range("T3").Select Selection.Copy Sheets("Elster Metering Limited").Select Range("G37").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
Je vois bien que l'opération est récurrente et que je pourrais créer une boucle mais comme je dois implémenter et mon filtre (Critéria1) de 7 à x et aussi coller les valeurs dans les cellules de E37 à "xx"37 je n'arrive pas à boucler la boucle.

Quelqu'un aurait-il une solution svp ?

Merci d'avance à tous

Bonjour MatMout,

un essai :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim i as long
Sheets("VENTE").Select
    Range("Q5").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=17, Criteria1:="Wave"
    Selection.AutoFilter Field:=7, Criteria1:="EL04"
    Selection.AutoFilter Field:=3, Criteria1:="1"
For i = 7 to 9 
    Selection.AutoFilter Field:=5, Criteria1:=i
    Sheets("VENTE").Range("T3").Copy
    Sheets("Elster Metering Limited").Cells(37,i-2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.cutcopymode=false
 Next i

15/07/2010, 18h35
MatMout

Salut Tototiti

merci beaucoup ça fonctionne très bien.

Et pour améliorer, sans les select, les copy pastespecil..etc
je suppose que la dernière ligne remplie se trouve en colonne A

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim LastLig As Long
Dim i As Byte
Application.ScreenUpdating = False
With Sheets("VENTE")
   LastLig = .Cells(Rows.Count, "A").End(xlUp).Row
   With .Range("A5")
      .AutoFilter
      .AutoFilter Field:=17, Criteria1:="Wave"
      .AutoFilter Field:=7, Criteria1:="EL04"
      .AutoFilter Field:=3, Criteria1:="1"
   End With
   For i = 0 To 2
      .Range("A5").AutoFilter Field:=5, Criteria1:=i + 7
      Sheets("Elster Metering Limited").Range("E37").Offset(0, i).Value = Application.Sum(.Range("T5:T" & LastLig).SpecialCells(xlCellTypeVisible))
   Next i
   .Range("A5").AutoFilter
End With

16/07/2010, 10h31
MatMout

Merci Mercatog

c'est vrai que les calculs se font plus vite comme ça!!