Filtre automatique bis

Bonjour à tout le forum
Je tente de filtrer un tabeau grace à un userfom(idée tiré d'un model de @Thiery, que j'avais téléchargé su ce site).
Disposition des cellulles A1:F1 =
Rf Dates Produits GrosDétail Montant
et le code est le suivant:

Option Explicit
Public ColNum As Integer
Public ColLet As String
Public Critere As String

Private Sub Label2_Click()

End Sub

'Thierry's Macro Demo sur www.Excel-Downloads.com
'=================================================================
'BETA TEST VERSION......... 26/11/2002...........BETA TEST VERSION
'=================================================================

Private Sub UserForm_Initialize()
Worksheets(1).AutoFilterMode = False
CommandButton1.Visible = False
ListBox1.AddItem ("Dates")
ListBox1.AddItem ("Produits")
ListBox1.AddItem ("Gros")
ListBox1.AddItem ("Détail")
ListBox1.AddItem ("Produits")
Label2.Caption = ""
End Sub

Private Sub ListBox1_Click()
Initialise
Dim NBLigne As Integer
Dim PlageFiltre As String
NBLigne = Sheets(1).Range(ColLet & "65536").End(xlUp).Row
PlageFiltre = Sheets(1).Range(ColLet & "2:" & ColLet & NBLigne).Address
ListBox2.RowSource = "DATABASE!" & PlageFiltre
End Sub
Sub Initialise()
Dim ChoixCol As String
ChoixCol = ListBox1.Text
ListBox3.Clear
Label2.Caption = ""
Select Case ChoixCol
Case "Dates"
ColNum = 1
ColLet = "A"
Case "Produits"
ColNum = 2
ColLet = "B"
Case "Gros"
ColNum = 3
ColLet = "C"
Case "Détail"
ColNum = 4
ColLet = "D"
Case "Montant"
ColNum = 5
ColLet = "E"
End Select

End Sub
Private Sub ListBox2_Click()
'Initialise
ListBox3.Clear
Label2.Caption = ""
CommandButton1.Visible = True
End Sub
Private Sub CommandButton1_Click()
Dim Critere As String
Dim cell As Range
Dim r As Range
Dim i As Integer
Dim tabT() As String
Dim w As Worksheet
Set w = Worksheets(1)
Critere = ListBox2.Value
ListBox3.Clear

If w.AutoFilterMode Then
w.AutoFilterMode = False
w.Range("A1").AutoFilter ColNum, Critere
Else
w.Range("A1").AutoFilter ColNum, Critere
End If

Set r = Sheets(1).Range("A1", [A65536].End(xlUp))
Set r = r.SpecialCells(xlCellTypeVisible)
ReDim tabT(0 To r.Count - 1)
For Each cell In r
tabT(i) = cell.Value
i = i + 1
Next
Me.ListBox3.List = tabT
Me.Label2.Caption = r.Count - 1
End Sub

Private Sub CommandButton2_Click()
Unload UserForm1
Worksheets(1).AutoFilterMode = False
End Sub

Mais à chaque fois que j'essai de le filtrer par date il me renvoi un message d'erreur 6. i= i+1 est maqué en jaune dans l'utilitaire de débbogage
Pouvez vous m'aider à résoudre ce probléme .

Merci d'avance.