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
| Sub TotalHtTvaCopiePourTravail()
Dim LeMois As Variant
Dim Cell As Range
Dim BonMois As Date
'Insertion d'une boite de message pour choisir le mois
LeMois = InputBox("Saisir le mois recherché", "SAISIE DU MOIS", "mois-aaaa")
'On suppose que la date a été saisie sous une autre forme (ex. juin 06)...
'... mais on cherche juin-06 -> On doit formater la date
BonMois = CVar(Format(CDate(LeMois), "mmmm-yyyy")) ' donne "mois-année"
Do While Not IsDate(BonMois)
LeMois = InputBox("Mauvaise saisie du mois" & Chr(10) & _
"Re-Saisir le mois" & Chr(10) & _
"Par exemple : mai-2006", "SAISIE DU MOIS", "mois-aaaa")
Loop
'Sélection du tableau actif
Sheets("Feuil1").Select
Range("A7").Select
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(6, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
'Tri des dates valeurs en ordre décroissant
Selection.Sort Key1:=Range("A8"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Plage = Range("A8", Range("A8").EntireColumn.Find(What:="*", _
SearchDirection:=xlPrevious)).Select
For Each Cell In Selection 'Pour chaque cellule de la sélection
If Month(Cell) = Month(BonMois) Then 'Si le mois = le mois cherché, alors
'Copier les lignes correspondantes dans "Feuil2"
Cell.EntireRow.Copy Sheets("Feuil2").Cells(Sheets("Feuil2").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next Cell 'Recherche sur les cellules suivantes
Application.CutCopyMode = False 'Annule mode copie
End Sub |
Partager