XL 2013 Erreur à la seconde exécution du programme

Cells.Find(What:=(var)).Select

Option Explicit
Private Sub Worksheet_Activate()
    Dim var As Date
    Dim numSem As Integer
    Dim NomSem As String
    Dim numLigne As Integer, numCol As Integer
    Dim Ma_Forme As Shape
    var = Format(Now(), "mm/yyyy")
    ThisWorkbook.Worksheets("Planning").Select
 
    Cells.Find(What:=(var)).Select
    
    numSem = DatePart("ww", Now(), vbMonday, vbFirstFourDays)
    If numSem < 10 Then
        NomSem = "S0" & numSem
    Else
        NomSem = "S" & numSem
    End If
    numLigne = ActiveCell.Row
    numCol = ActiveCell.Column
    Cells.Range(Cells(numLigne + 1, numCol - 1), Cells(numLigne + 1, numCol + 4)).Find(What:=(NomSem), SearchOrder:=xlByRows, LookIn:=xlValues).Select

    'Supprimer et recréer la forme à la bonne position
    For Each Ma_Forme In Sheets("Planning").Shapes
        If Ma_Forme.Name = "Ligne" Then
            Ma_Forme.Delete
            Exit For
        End If
    Next Ma_Forme
    With ThisWorkbook.Worksheets("Planning").Shapes.AddShape(msoShapeLineCallout1NoBorder, ActiveCell.Left, 0, 2.25, 5000)
        .Name = "Ligne"
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
    End With