Discussion :

[Alla.pero]

Bonjour à toutes et à tous,

je suis à la recherche d'une macro qui me sélectionne des catégories selon deux critères.
Je vais essayer de m'expliquer : j'aimerais que cela ouvre une nouvelle page excel pour réaliser l'opération


J'ai un tableau avec des numéros d'IMB, et à ces numéros sont marqués soit "NOK" soit "OK" sur la colonne U.
J'aimerais que pour chaque numéro d'IMB contenant le "NOK", la ligne soit copiée dans un autre tableau excel.
Ensuite même type de formule, mais avec la colonne Y.

Cependant j'aimerais que ce tri soit fait sur le même excel que l'on a ouvert avec la nouvelle page. Le tout pour que cela donne ceci :


Merci d'avance

[Invité]

Bonsoir,

Sans macro, vous pourriez vous imbiber de ça : advancedfilter

[ARTURO83]

Bonjour,

Autre proposition avec macro (Je suppose, d'après ce que vous montrez que les IMB sont en colonne N)
Pièce jointe 497211

Le 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
Sub Filtre()
    Dim DerLig_f1 As Long, DerLig_f2 As Long, DerCol_f2 As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("BDD")
    Set f2 = Sheets("Filtre")
    f2.Cells.Clear
    DerLig_f1 = f1.[N100000].End(xlUp).Row
    If f1.AutoFilterMode = False Then f1.Rows(1).AutoFilter
    f1.Range("A1:Y" & DerLig_f1).AutoFilter Field:=21, Criteria1:="NOK"
    NbCol = f1.[IV1].End(xlToLeft).Column
    f1.Range(Cells(1, "N"), Cells(DerLig_f1, "N")).SpecialCells(xlCellTypeVisible).Copy Destination:=f2.[A1]
    f1.Range(Cells(1, "U"), Cells(DerLig_f1, "U")).SpecialCells(xlCellTypeVisible).Copy Destination:=f2.[B1]
    f1.Range(Cells(1, "Y"), Cells(DerLig_f1, "Y")).SpecialCells(xlCellTypeVisible).Copy Destination:=f2.[C1]
    DerLig_f2 = f2.[A100000].End(xlUp).Row
    f1.AutoFilterMode = False
    f1.Range("A1:Y" & DerLig_f1).AutoFilter Field:=25, Criteria1:="NOK"
    f1.Range(Cells(2, "N"), Cells(DerLig_f1, "N")).SpecialCells(xlVisible).Copy Destination:=f2.Cells(DerLig_f2 + 1, "A")
    f1.Range(Cells(2, "U"), Cells(DerLig_f1, "U")).SpecialCells(xlVisible).Copy Destination:=f2.Cells(DerLig_f2 + 1, "B")
    f1.Range(Cells(2, "Y"), Cells(DerLig_f1, "Y")).SpecialCells(xlVisible).Copy Destination:=f2.Cells(DerLig_f2 + 1, "C")
    f1.AutoFilterMode = False
    f2.Select
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt

[Alla.pero]

Bonsoir,

Sans macro, vous pourriez vous imbiber de ça : advancedfilter

Je vais effectivement lire ceci car cela pourrait m'aider dans l'avenir, merci.

[Alla.pero]

Bonjour,

Autre proposition avec macro (Je suppose, d'après ce que vous montrez que les IMB sont en colonne N)
Pièce jointe 497211

Le 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
Sub Filtre()
    Dim DerLig_f1 As Long, DerLig_f2 As Long, DerCol_f2 As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("BDD")
    Set f2 = Sheets("Filtre")
    f2.Cells.Clear
    DerLig_f1 = f1.[N100000].End(xlUp).Row
    If f1.AutoFilterMode = False Then f1.Rows(1).AutoFilter
    f1.Range("A1:Y" & DerLig_f1).AutoFilter Field:=21, Criteria1:="NOK"
    NbCol = f1.[IV1].End(xlToLeft).Column
    f1.Range(Cells(1, "N"), Cells(DerLig_f1, "N")).SpecialCells(xlCellTypeVisible).Copy Destination:=f2.[A1]
    f1.Range(Cells(1, "U"), Cells(DerLig_f1, "U")).SpecialCells(xlCellTypeVisible).Copy Destination:=f2.[B1]
    f1.Range(Cells(1, "Y"), Cells(DerLig_f1, "Y")).SpecialCells(xlCellTypeVisible).Copy Destination:=f2.[C1]
    DerLig_f2 = f2.[A100000].End(xlUp).Row
    f1.AutoFilterMode = False
    f1.Range("A1:Y" & DerLig_f1).AutoFilter Field:=25, Criteria1:="NOK"
    f1.Range(Cells(2, "N"), Cells(DerLig_f1, "N")).SpecialCells(xlVisible).Copy Destination:=f2.Cells(DerLig_f2 + 1, "A")
    f1.Range(Cells(2, "U"), Cells(DerLig_f1, "U")).SpecialCells(xlVisible).Copy Destination:=f2.Cells(DerLig_f2 + 1, "B")
    f1.Range(Cells(2, "Y"), Cells(DerLig_f1, "Y")).SpecialCells(xlVisible).Copy Destination:=f2.Cells(DerLig_f2 + 1, "C")
    f1.AutoFilterMode = False
    f2.Select
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt

Parfait merci d'avoir pris le temps pour cette macro, je la test demain et je vous tiens au courant.
Les IMB sont bien en colonnes N

Bonne soirée.

[Alla.pero]

Bonjour,

Autre proposition avec macro (Je suppose, d'après ce que vous montrez que les IMB sont en colonne N)
Pièce jointe 497211

Le 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
Sub Filtre()
    Dim DerLig_f1 As Long, DerLig_f2 As Long, DerCol_f2 As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("BDD")
    Set f2 = Sheets("Filtre")
    f2.Cells.Clear
    DerLig_f1 = f1.[N100000].End(xlUp).Row
    If f1.AutoFilterMode = False Then f1.Rows(1).AutoFilter
    f1.Range("A1:Y" & DerLig_f1).AutoFilter Field:=21, Criteria1:="NOK"
    NbCol = f1.[IV1].End(xlToLeft).Column
    f1.Range(Cells(1, "N"), Cells(DerLig_f1, "N")).SpecialCells(xlCellTypeVisible).Copy Destination:=f2.[A1]
    f1.Range(Cells(1, "U"), Cells(DerLig_f1, "U")).SpecialCells(xlCellTypeVisible).Copy Destination:=f2.[B1]
    f1.Range(Cells(1, "Y"), Cells(DerLig_f1, "Y")).SpecialCells(xlCellTypeVisible).Copy Destination:=f2.[C1]
    DerLig_f2 = f2.[A100000].End(xlUp).Row
    f1.AutoFilterMode = False
    f1.Range("A1:Y" & DerLig_f1).AutoFilter Field:=25, Criteria1:="NOK"
    f1.Range(Cells(2, "N"), Cells(DerLig_f1, "N")).SpecialCells(xlVisible).Copy Destination:=f2.Cells(DerLig_f2 + 1, "A")
    f1.Range(Cells(2, "U"), Cells(DerLig_f1, "U")).SpecialCells(xlVisible).Copy Destination:=f2.Cells(DerLig_f2 + 1, "B")
    f1.Range(Cells(2, "Y"), Cells(DerLig_f1, "Y")).SpecialCells(xlVisible).Copy Destination:=f2.Cells(DerLig_f2 + 1, "C")
    f1.AutoFilterMode = False
    f2.Select
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt

Bonjour,

après avoir modifié le nom des onglets sur mon fichier, cette macro marche bel et bien, merci beaucoup !

Bonne journée à vous.