Problem mit DATUM code von frmCalendar

Private Sub cmdClose_Click()
' Close the UserForm
Unload Me
End Sub

Private Sub UserForm_Initialize()
' Check if active cell contains a date. If 'yes' show
' same date on calendar. If 'no' show today's date.
If IsDate(ActiveCell.Value) Then
Calendar1.Value = DateValue(ActiveCell.Value)
Else
Calendar1.Value = Date
End If
End Sub

Private Sub Calendar1_Click()
' Transfer date selected on calendar to active cell
' and close UserForm.
Dim wks As Worksheet
Dim i As Integer
Dim rngFind As Range
On Error GoTo Fehler
For i = 2 To Worksheets.Count                 'von der 2ten bis zur letzten Seite ...
Set wks = Worksheets(i)
With wks
Set rngFind = .Cells.Find(Calendar1.Value)
If Not rngFind Is Nothing Then
.Activate
rngFind.Select
Unload Me
End If
End With
Next
Fehler:
Call Fehler
End Sub

Private Sub Fehler()
MsgBox "Datum nicht vorhanden! Aktion abgebrochen!"
Exit Sub
End Sub