XL 2010 [VBA] Filtre et extraction données [RESOLU]

warrio

XLDnaute Nouveau
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 accélérer le traitement mais mes compétences sont limitées en VBA.
merci pour votre aide.
cordialement
Code:
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
 

Fichiers joints

Lolote83

XLDnaute Accro
Salut Warrio,
Quel est le critère pour affecter ton listing (BD) sur Janvier, février, mars .....
Je pensais à une date mais je n'ai pas trouvé sur quelle colonne il faut intervenir
Merci de me dire
@+ Lolote83
 

warrio

XLDnaute Nouveau
Salut Warrio,
Quel est le critère pour affecter ton listing (BD) sur Janvier, février, mars .....
Je pensais à une date mais je n'ai pas trouvé sur quelle colonne il faut intervenir
Merci de me dire
@+ Lolote83
la colonne "AK" représente les mois de 1 a 12 (1 pour janvier 12 pour decembre)
 

Lolote83

XLDnaute Accro
Salut à tous,
@warrio: ;), désolé de mettre mon grain de sel, mais il me semble que la solution basée sur les filtres élaborés ne donne pas les résultats escomptés, à toi de voir c'est ton fichier.
bonne continuation.
En quoi la solution proposée via les filtres élaborées n'est pas conforme à la demande ?
Ai-je oublié quelques choses ?
Cordialement
Lolote83
 

Discussions similaires


Haut Bas