Discussion :

[delphine1987]

bonjour

Je souhaite filtrer par couleur la colonne 24 (en plus de la condition de >0). Je crois qu’on ne peut pas faire cette manipulation avec autofilter. Est ce que quelqu’un à une solution ?
Merci d’avance

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
Sub reporter_std()
Dim Sh As Worksheet
 
Dim LastLig As Long, NewLig As Long
Dim i As Integer
Dim c As Range
Dim Valeur As String
 
 
Valeur = InputBox("Entrée période", "Choix de la période")
If Valeur <> "" Then
Application.ScreenUpdating = False
With Workbooks("2010 STD Activities status.xls").Sheets("2010")
   .AutoFilterMode = False
   LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
   With .Range("A4:X" & LastLig)
      .AutoFilter field:=17, Criteria1:=Valeur
      .AutoFilter field:=24, Criteria1:=">0"
      .AutoFilter field:=9, Criteria1:="STD"
     End With
   If .Range("A4:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
      Set Sh = Worksheets("std")
      NewLig = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row + 1
      For Each c In .Range("A5:A" & LastLig).SpecialCells(xlCellTypeVisible)
         Sh.Cells(NewLig, 1).Value = .Cells(c.Row, 7).Value
         Sh.Cells(NewLig, 2).Value = .Cells(c.Row, 8).Value
         Sh.Cells(NewLig, 5).Value = .Cells(c.Row, 10).Value
         Sh.Cells(NewLig, 7).Value = .Cells(c.Row, 12).Value
         Sh.Cells(NewLig, 16).Value = .Cells(c.Row, 17).Value
         Sh.Cells(NewLig, 12).Value = .Cells(c.Row, 24).Value
         Sh.Cells(NewLig, 8).Value = .Cells(c.Row, 9).Value
         Sh.Cells(NewLig, 9).Value = .Cells(c.Row, 29).Value
         Sh.Cells(NewLig, 3).Value = UCase(Sh.Cells(NewLig, 1).Value) & UCase(Sh.Cells(NewLig, 2).Value)
         Sh.Cells(NewLig, 3).Value = Replace(Cells(NewLig, 3).Value, " ", "")
         NewLig = NewLig + 1
 
 
      Next c
      Set Sh = Nothing
      .AutoFilterMode = False
   End If
End With
End If
End Sub

[mercatog]

Bonjour
Ajoute un test sur la couleur de la cellule colonne X

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
Sub reporter_std()
Dim Sh As Worksheet
 
Dim LastLig As Long, NewLig As Long
Dim i As Integer
Dim c As Range
Dim Valeur As String
 
 
Valeur = InputBox("Entrée période", "Choix de la période")
If Valeur <> "" Then
    Application.ScreenUpdating = False
    With Workbooks("2010 STD Activities status.xls").Sheets("2010")
        .AutoFilterMode = False
        LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
        With .Range("A4:X" & LastLig)
            .AutoFilter field:=17, Criteria1:=Valeur
            .AutoFilter field:=24, Criteria1:=">0"
            .AutoFilter field:=9, Criteria1:="STD"
        End With
        If .Range("A4:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
            Set Sh = Worksheets("std")
            NewLig = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row + 1
            For Each c In .Range("A5:A" & LastLig).SpecialCells(xlCellTypeVisible)
                'Ajoute ce test
                If c.Offset(0, 23).Interior.Color = vbRed Then
                    Sh.Cells(NewLig, 1).Value = .Cells(c.Row, 7).Value
                    Sh.Cells(NewLig, 2).Value = .Cells(c.Row, 8).Value
                    Sh.Cells(NewLig, 5).Value = .Cells(c.Row, 10).Value
                    Sh.Cells(NewLig, 7).Value = .Cells(c.Row, 12).Value
                    Sh.Cells(NewLig, 16).Value = .Cells(c.Row, 17).Value
                    Sh.Cells(NewLig, 12).Value = .Cells(c.Row, 24).Value
                    Sh.Cells(NewLig, 8).Value = .Cells(c.Row, 9).Value
                    Sh.Cells(NewLig, 9).Value = .Cells(c.Row, 29).Value
                    Sh.Cells(NewLig, 3).Value = UCase(Sh.Cells(NewLig, 1).Value) & UCase(Sh.Cells(NewLig, 2).Value)
                    Sh.Cells(NewLig, 3).Value = Replace(Cells(NewLig, 3).Value, " ", "")
                    NewLig = NewLig + 1
                End If
            Next c
            Set Sh = Nothing
            .AutoFilterMode = False
        End If
    End With
End If
End Sub

[delphine1987]

merci pour ta réponse
J'ai essayé de mettre un If entre les autofilter mais ça ne fonctionne pas, je ne sais pas ou le mettre dans mon code.
Merci
Delphine

[mercatog]

Mais si tu regardais de près, je l'avais déjà ajouté
la variable c parcourt les lignes visibles de la colonne A
on fait le test sur la cellule de la même ligne sur la colonne X (l'offset à droit de 23 colonnes)
si la couleur de la cellule est rouge alors on reporte les données
regarde cette partie

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
                'Ajoute ce test
                If c.Offset(0, 23).Interior.Color = vbRed Then
                    Sh.Cells(NewLig, 1).Value = .Cells(c.Row, 7).Value
                    Sh.Cells(NewLig, 2).Value = .Cells(c.Row, 8).Value
                    Sh.Cells(NewLig, 5).Value = .Cells(c.Row, 10).Value
                    Sh.Cells(NewLig, 7).Value = .Cells(c.Row, 12).Value
                    Sh.Cells(NewLig, 16).Value = .Cells(c.Row, 17).Value
                    Sh.Cells(NewLig, 12).Value = .Cells(c.Row, 24).Value
                    Sh.Cells(NewLig, 8).Value = .Cells(c.Row, 9).Value
                    Sh.Cells(NewLig, 9).Value = .Cells(c.Row, 29).Value
                    Sh.Cells(NewLig, 3).Value = UCase(Sh.Cells(NewLig, 1).Value) & UCase(Sh.Cells(NewLig, 2).Value)
                    Sh.Cells(NewLig, 3).Value = Replace(Cells(NewLig, 3).Value, " ", "")
                    NewLig = NewLig + 1
                End If

[delphine1987]

Bonjour
Merci pour ton aide
J'ai mis font à la place d'interior
Par contre, est ce que tu peux m'expliquer pourquoi tu mets 23 quand tu écris If c.offset(0,23).font.color=vbred

Merci encore

[mercatog]

la variable c parcourt les lignes visibles de la colonne A
on fait le test sur la cellule de la même ligne sur la colonne X (l'offset à droite de 23 colonnes)

La colonne B à un offset de 1 par rapport à la colonne A
La colonne C à un offset de 2 par rapport à la colonne A
...
La colonne X à un offset de 23 par rapport à la colonne A