Sheet sorting/naming problem

I have some code that sorts rows of data into a varied number new excel sheets. (named with month names ie jan_06).

This works by looking at the data source, creating sheets if none exsist and adding the data row to it.

Else creating a new Sheet to acomodate that month, until sheet 3 is sorted.

The problem being that the naming of sheet tabs are not quite working.

Data gets sorted into jan 05 for example weither the data is jan 05 or 06.

The problem may lie in This line, i am not sure. Can anyone see the problem.

If IsDate(cl.Value) Then Sht = MonthName(Month(cl.Value)) & "_" & Format(Year(Date), "yy")

Whole macro:

    Dim Sht    As String
    
    On Error GoTo ErrorHandlingSortDataToMonths 
    
        With Application
            .DisplayAlerts = False
            .ScreenUpdating = False     
            .Calculation = xlCalculationManual
  
            Set shtData = Sheet3  
            
                With shtData
                    Set rng = .Range(.Cells(2, 5), .Cells(.Rows.Count, 5).End(xlUp))  
                   For Each cl In rng
                        If IsDate(cl.Value) Then Sht = MonthName(Month(cl.Value)) & "_" & Format(Year(Date), "yy")  
                        If Not wsExists(Sht) Then                                                      
                            Worksheets.Add After:=Worksheets(Worksheets.Count)
                            ActiveSheet.Name = Sht
                            'add header row                        
                            .Cells(1, 1).EntireRow.Copy Sheets(Sht).Cells(1, 1) 'Then add the row of data
                        End If
                        If Not IsEmpty(cl) Then cl.EntireRow.Copy Sheets(Sht).Cells(Rows.Count, 1).End(xlUp).offSet(1, 0)
                    Next cl                                              
                    .Select 
                End With
            
            Worksheets(1).Select

                .DisplayAlerts = True
                .ScreenUpdating = True              
                .Calculation = xlCalculationAutomatic
        End With

                
ErrorHandlingSortDataToMonths:
    
Dim ErrorSht    As Worksheet
Dim Msg As String
    
    Select Case Err
        Case 1004: 'Data may not have been imported to data sheet
            Msg = "An Error Has Occured" & vbNewLine
            Msg = Msg & "Check that there is data in sheet 3 (Data) and retry"    
            MsgBox Msg
            
            For Each ErrorSht In ThisWorkbook.Worksheets
                If ErrorSht.Index > 3 Then ErrorSht.Delete          
            Next ErrorSht
            
            Worksheets(1).Select
        
        Exit Sub
    Case Else
End Select

Call AddFormulas
        
        
End Sub

Thanx George