Sub Macro2()
Dim dDate As Long, fDate As Long
Dim T As Variant, rngfilter As Range
Dim nbC As Integer, nbL As Integer
Application.ScreenUpdating = False
With ActiveSheet
nbC = .UsedRange.Columns.Count
T = .Range(.Cells(5, 1), .Cells(5, nbC)).Value
For i = 1 To 12
.AutoFilterMode = False
dDate = CLng(DateSerial(2010, i, 1))
fDate = CLng(DateSerial(2010, i + 1, 1))
.Range("A5").AutoFilter Field:=4, Criteria1:=">=" & dDate, Operator:=xlAnd, Criteria2:="<" & fDate
With .AutoFilter.Range
On Error Resume Next
Set rngfilter = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible)
If Err.Number = 0 Then
nbL = rngfilter.Rows.Count + 1
Sheets.Add after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Format(dDate, "mmmm")
.Range(.Cells(1, 1), .Cells(1, nbC)) = T
rngfilter.Copy .Range("A2")
.Cells(nbL + 1, 4) = "Total"
.Cells(nbL + 1, 5) = CCur(Application.Sum(.Range("E2:E" & nbL)))
.Columns.AutoFit
End With
End If
[COLOR="Blue"]On Error GoTo 0[/COLOR]
End With
Next
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub