Calendrier qui conserve les données

Private Sub Worksheet_Deactivate()
Dim P As Range, i As Byte, nom As Name
Set P = [B4:AE11] 'à adapter éventuellement
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
For i = 1 To 12
    P.SpecialCells(xlCellTypeBlanks) = "=""""" 'texte vide dans les cellules vides (évite les #N/A)
    Set nom = ThisWorkbook.Names.Add("Memo" & Format(P(-1, 0), "yyyy_mm"), P.Value) 'mémorise dans un nom défini
    'nom.Visible = False 'facultatif, masque le nom
    Set P = P.Offset(13) 'mois suivant
Next
End Sub

Private Sub Worksheet_Activate()
Dim P As Range, i As Byte, nom As String
Set P = [B4:AE11] 'à adapter éventuellement
Application.ScreenUpdating = False
For i = 1 To 12
    nom = "Memo" & Format(P(-1, 0), "yyyy_mm")
    If IsArray(Evaluate(nom)) Then P.FormulaArray = "=" & nom Else P = "" 'restitution par formule matricielle
    P = P.Value 'supprime la formule
    Set P = P.Offset(13) 'mois suivant
Next
End Sub