Discussion :

[DAVIDSAVOIE]

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.

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
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

[Philippe Tulliez]

Bonjour,
Il semble que ce soit une exportation sous condition. Pour cela, j'utilise la méthode AdvancedFilter

Voici un exemple de procédure qui exporte les lignes de la colonne nommée Libellé si la valeur contenue dans la colonne Rayon contient l'un des trois éléments que l'on retrouve dans la plage nommée areaCriteria (plage M1:M4). L'exportation a lieu dans une nouvelle feuille

La source de données est un tableau structuré qui est seul dans la feuille dont la propriété CodeName est shtData

Code de la procédure

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
Sub T()
  ' Déclarartion
  Const Label2Export As String = "Libellé"  '  Etiquette de la colonne à exporter
  Dim oList As ListObject
  Dim rngSource As Range
  Dim rngTarget As Range
  ' Assignation
  Set oList = shtData.ListObjects(1)
  Set rngSource = oList.Range
  With rngSource
    ' Enlève une ligne à l'objet rngSource si la propriété ShowTotals de l'objet oLst est égal à True
    Set rngSource = .Resize(.Rows.Count - Abs(oList.ShowTotals))
  End With
  ' Start Process
  ThisWorkbook.Worksheets.Add             ' Insère une feuille
  Set rngTarget = ActiveSheet.Cells(1, 1) ' Référencement à la Feuille cible
  rngTarget.Value = Label2Export          ' Ecrit l'étiquette de colonne
  ' Exportation suivant critères
  rngSource.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("areaCriteria"), CopyToRange:=rngTarget
  ' ici le tri
  ' EndOfProcess
  Set oList = Nothing: Set rngSource = Nothing: Set rngTarget = Nothing
End Sub

Illustration


Liens pour en savoir plus sur

• Les tableaux structurés
• Les filtres avancés d'excel (AdvancedFilter)
• La propriété CodeName d'une feuille

[DAVIDSAVOIE]

Bonjour Philippe Tulliez,
Merci beaucoup pour ta solution, mais étant novice, je n'arrive pas a utiliser le code.
Cordialement.
David.