Réalisation mensuel par excel

=SOMMEPROD((MOIS($B$2:$B$77)=MOIS(D1))*1)

Sub test()
'ecrire le mois dans la colonne P
'faire un filtre sur la colonne
'transcrire la colonne dans le bon mois
    Sheets("Feuil1").Select
    RowCount = Cells(Cells.Rows.Count, "b").End(xlUp).Row
    Range("b2").Select
    For i = 2 To RowCount
        Range("b" & i).Select
        cval = ActiveCell.Value
        cval2 = Mid(cval, 4, 2)

        Select Case cval2
        Case 1
            wmonth = "Jan"
            Range("P" & i).Select
            ActiveCell.Value = wmonth
        Case 2
            wmonth = "Feb"
            Range("P" & i).Select
            ActiveCell.Value = wmonth
        Case 3
            wmonth = "Mar"
            Range("P" & i).Select
            ActiveCell.Value = wmonth
        Case 4
            wmonth = "Apr"
            Range("P" & i).Select
            ActiveCell.Value = wmonth
        Case 5
            wmonth = "May"
            Range("P" & i).Select
            ActiveCell.Value = wmonth
        Case 6
            wmonth = "Jun"
            Range("P" & i).Select
            ActiveCell.Value = wmonth
        Case 7
            wmonth = "Jul"
            Range("P" & i).Select
            ActiveCell.Value = wmonth
        Case 8
            wmonth = "Aug"
            Range("P" & i).Select
            ActiveCell.Value = wmonth
        Case 9
            wmonth = "Sep"
            Range("P" & i).Select
            ActiveCell.Value = wmonth
        Case 10
            wmonth = "Oct"
            Range("P" & i).Select
            ActiveCell.Value = wmonth
        Case 11
            wmonth = "Nov"
            Range("P" & i).Select
            ActiveCell.Value = wmonth
        Case 12
            wmonth = "Dec"
            Range("P" & i).Select
            ActiveCell.Value = wmonth
        End Select
    Next
    'faire un filtre sur la colonne P
    myarray = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    For j = 0 To 11
        Range("A1:P" & RowCount).Select
        Selection.AutoFilter Field:=16, Criteria1:=myarray(j)
        Rowcount1 = Cells(Cells.Rows.Count, "b").End(xlUp).Row
        If Rowcount1 = 1 Then
            'GoTo line1
        End If
        'transcrire la colonne dans le bon mois
        'Trouve la bonne colonne
        Range("A1").Select
        With ActiveSheet
            valu = myarray(j)
            valu = valu & "*"
            Set rFound = .UsedRange.Find(valu, .Cells(1, 1), xlValues, xlWhole, , , False)
            Application.Goto rFound, True
            adr = ActiveCell.Address(rowabsolute, columnabsolute)
            adr = Left(adr, 1)

        End With
        With ActiveSheet.AutoFilter.Range
            Set rng = ActiveSheet.AutoFilter.Range
            rng.Offset(1, 1).Resize(rng.Rows.Count).Copy _
                    Destination:=Worksheets("Feuil2").Range(adr & "2")

            ActiveSheet.ShowAllData


        End With

    Next
    'copy de feuil2 a feuil1
    Sheets("Feuil2").Select
    ActiveSheet.UsedRange.Copy _
            Destination:=Worksheets("Feuil1").Range("D2")
    'nettoyage
    Sheets("Feuil2").Select
    ActiveSheet.UsedRange.ClearContents
    Range("A1").Select
    Sheets("Feuil1").Select
    Selection.AutoFilter
    Columns("P:P").Select
    Selection.Delete Shift:=xlToLeft
    Range("D2").Select
End Sub