Modification Macro

Bonjour,

J'ai une macro qui me permet de copier sur une "feuille 2" par ordre alphabétique et sur une seule colonne toutes les données d'une autre "feuille 1".

J'aimerais pouvoir copier certaines données en spécifiant des mots clés ( par exemple : poulet; filet; cuisses) dans une autre "feuille 3" avec le même système, les données de la "feuille 1".

Que faut-il que je rajoute, dans ma macro pour arriver à avoir sur la "feuille 3" par ordre alphabétique et sur une seule colonne toutes les données qui correspondent à poulet; filet; cuisses ?

Merci pour votre aide.

Option Explicit

Sub Au_menu()

Dim c As Range

With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With

Sheets("LISTE TOTAL MIDI").Cells.Clear

Range("midi").Copy Destination:=Sheets("LISTE TOTAL MIDI").Range("a1")

Sheets("LISTE TOTAL MIDI").Activate

Columns("A:F").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

Range(Range("b1"), Range("b1").End(xlDown)).Cut Destination:=Range("a65536").End(3)(2)

Range(Range("c1"), Range("c1").End(xlDown)).Cut Destination:=Range("a65536").End(3)(2)

Range(Range("d1"), Range("d1").End(xlDown)).Cut Destination:=Range("a65536").End(3)(2)

Range(Range("e1"), Range("e1").End(xlDown)).Cut Destination:=Range("a65536").End(3)(2)

Range(Range("f1"), Range("f1").End(xlDown)).Cut Destination:=Range("a65536").End(3)(2)

Columns("A:A").SpecialCells(xlCellTypeConstants, 23).Value = Application.Trim(Columns("A:A").SpecialCells(xlCellTypeConstants, 23).Value)

With Range("A:A")

.Sort Range("A1"), xlAscending, Header:=xlNo

.Font.Size = 10

.WrapText = False

.EntireColumn.AutoFit

.HorizontalAlignment = xlLeft

End With

Sheets("LISTE TOTAL SOIR").Cells.Clear

Range("soir").Copy Destination:=Sheets("LISTE TOTAL SOIR").Range("a1")

Sheets("LISTE TOTAL SOIR").Activate

Columns("A:F").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

Range(Range("b1"), Range("b1").End(xlDown)).Cut Destination:=Range("a65536").End(3)(2)

Range(Range("c1"), Range("c1").End(xlDown)).Cut Destination:=Range("a65536").End(3)(2)

Range(Range("d1"), Range("d1").End(xlDown)).Cut Destination:=Range("a65536").End(3)(2)

Range(Range("e1"), Range("e1").End(xlDown)).Cut Destination:=Range("a65536").End(3)(2)

Range(Range("f1"), Range("f1").End(xlDown)).Cut Destination:=Range("a65536").End(3)(2)

Columns("A:A").SpecialCells(xlCellTypeConstants, 23).Value = Application.Trim(Columns("A:A").SpecialCells(xlCellTypeConstants, 23).Value)

With Range("A:A")

.Sort Range("A1"), xlAscending, Header:=xlNo

.Font.Size = 10

.WrapText = False

.EntireColumn.AutoFit

.HorizontalAlignment = xlLeft

End With

With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With

End Sub

Bonjour,

Il est sans doute possible d'utiliser les filtres avancés. A voir sur le fichier.

Bonjour,

Voilà le fichier.

Merci.

Sub FiltreSelectif()
    Range("C1").CurrentRegion.Offset(1, 0).Clear
    Range("ENTREES").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1").CurrentRegion, CopyToRange:=Range("C1"), Unique:=False
End Sub

Super Steelson.

Merci Beaucoup.