[VBA] Filtre et extraction données

1 pièce(s) jointe(s)

Bonjour,

je vous sollicite afin d'optimiser une macro que j'ai réalisée.
Je dispose d'un fichier alimenté par différentes personnes, dans l'onglet "BD"
le but étant de faire un filtre mensuel (1 a 12 colonne "AK") et extraire une partie des données visible après filtrage (toujours les mêmes plage (colonne B a G) + Y + (colonne AC a AE) + AH et AI )
et les copier dans les onglets correspondant pour mettre à jour le fichier.
si je pouvais avoir une mise en forme standard avec bordure ce serais un plus.

je vous joins un fichier dans laquelle la macro est dans le module

j'ai essayé de passer par un tableau pour accelerer le traitement mais mes compétences sont limitées en VBA.
merci pour votre aide.
cordialement

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
 
Option Explicit
 
Dim f, i, ln, lgn, mois, mafeuille
 
 
Sub trimensuel()
 
'applique filtre mensuel
 
    Application.ScreenUpdating = False
    Sheets("BD").Activate
 
    'boucle sur 12 mois
    For mois = 1 To 12
 
       Select Case mois
      Case 1
        mafeuille = "Janvier"
      Case 2
        mafeuille = "Février"
      Case 3
       mafeuille = "Mars"
      Case 4
       mafeuille = "Avril"
      Case 5
        mafeuille = "Mai"
      Case 6
        mafeuille = "Juin"
         Case 7
        mafeuille = "Juillet"
         Case 8
        mafeuille = "Aout"
         Case 9
       mafeuille = "Septembre"
         Case 10
        mafeuille = "Octobre"
         Case 11
        mafeuille = "Novembre"
         Case 12
        mafeuille = "Décembre"
 
    End Select
 
 
 
    '---
    Set f = Sheets("BD")
    f.Range("A5:BC" & f.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=1
    f.Range("A5:BC" & f.Range("A" & Rows.Count).End(xlUp).Row).Sort _
                key1:=Range("AI5"), order1:=xlAscending, _
                key2:=Range("B5"), order1:=xlAscending, _
                Header:=xlGuess
    f.Range("A5:BC" & f.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=37, Criteria1:=mois 'tri par mois
 
 
 
       Sheets(mafeuille).Range("A2:L" & Sheets(mafeuille).Range("A" & Rows.Count).End(xlUp)(2).Row).ClearContents
 
    i = 0
           lgn = Sheets(mafeuille).Range("A" & Rows.Count).End(xlUp).Row
 
 
    For ln = 6 To f.Range("A" & Rows.Count).End(xlUp).Row
 
        If f.Rows(ln & ":" & ln).EntireRow.Hidden = False Then
            i = i + 1
            lgn = lgn + 1
 
 
              f.Range("B" & ln).Copy: Sheets(mafeuille).Range("A" & lgn).PasteSpecial xlPasteValues
            f.Range("C" & ln).Copy: Sheets(mafeuille).Range("B" & lgn).PasteSpecial xlPasteValues
            f.Range("D" & ln).Copy: Sheets(mafeuille).Range("C" & lgn).PasteSpecial xlPasteValues
            f.Range("E" & ln).Copy: Sheets(mafeuille).Range("D" & lgn).PasteSpecial xlPasteValues
            f.Range("F" & ln).Copy: Sheets(mafeuille).Range("E" & lgn).PasteSpecial xlPasteValues
            f.Range("G" & ln).Copy: Sheets(mafeuille).Range("F" & lgn).PasteSpecial xlPasteValues
            f.Range("Y" & ln).Copy: Sheets(mafeuille).Range("G" & lgn).PasteSpecial xlPasteValues
            f.Range("AC" & ln).Copy: Sheets(mafeuille).Range("H" & lgn).PasteSpecial xlPasteValues
            f.Range("AD" & ln).Copy: Sheets(mafeuille).Range("I" & lgn).PasteSpecial xlPasteValues
            f.Range("AE" & ln).Copy: Sheets(mafeuille).Range("J" & lgn).PasteSpecial xlPasteValues
            f.Range("AH" & ln).Copy: Sheets(mafeuille).Range("K" & lgn).PasteSpecial xlPasteValues
            f.Range("AI" & ln).Copy: Sheets(mafeuille).Range("L" & lgn).PasteSpecial xlPasteValues
 
            If i = 20 Then Exit For
        End If
    Next ln
    '-----
 
 
     'fin boucle mois
     Next mois
 
 
 
     '-------
 
 
    f.Range("A5:BC" & f.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter 'Field:=1
    f.Range("A5:BC" & f.Range("A" & Rows.Count).End(xlUp).Row).Sort _
                key2:=Range("AI5"), order1:=xlAscending, _
                key1:=Range("B5"), order1:=xlAscending, _
                Header:=xlGuess
   f.Range("A5:BC5").AutoFilter
 
    MsgBox "Travail terminé"
 
 
    Sheets("BD").Select
 
End Sub

Pièce jointe 336013

re

Bonjour j'ai regarder ton classeur
et un filtre en bon et due forme ne fonctionne pas il dois y avoir un soucis avec tes dates

on filtre les dates d'un mois comme ceci
exemple pour fevrier

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
Dim Date1, Date2, plage As Range
    Date1 = "01/02/2017"
    Date2 = "28/02/2017"
    Set plage = Sheets("BD").Range("A6:Z19")
    With plage
        .AutoFilter Field:=4, Criteria1:="<" & CLng(CDate(Date2)) , Operator:=xlAnd, Criteria2:=">" & CLng(CDate(Date1))
        MsgBox plage.SpecialCells(xlVisible).Address
            Set rangeAgarder = plage.SpecialCells(xlVisible)
  plage.AutoFilter
 
    End With
End Sub

Bonjour,

cette simple phrase

Citation:

le but étant de faire un filtre mensuel (1 a 12 colonne "AK") et extraire une partie des données visible après filtrage (toujours les mêmes plage (colonne B a G) + Y + (colonne AC a AE) + AH et AI )
et les copier dans les onglets correspondant pour mettre à jour le fichier.

renvoi à un outil puissant, efficace, et dédié à ce travail : filtres avancés

à utiliser avec un critère calculé basé sur la fonction MOIS()