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