XL 2010 Copier coller contenu de cellule d'une feuille à l'autre.

Private Sub Worksheet_Activate()
Dim jour As Range, v As Variant
Set jour = [B2]
While jour <> ""
    v = Application.VLookup(jour, Feuil1.[B:C], 2, 0)
    jour(4) = IIf(IsError(v), "", v)
    Set jour = jour(5)
Wend
End Sub

Sub Creer_calendrier()
Dim x$, s, deb$, fin$, P As Range, i&, dat&
Do
    x = InputBox("Entrez la date de début et la date de fin séparées par un espace :", "Créer le calendrier", x)
    If x = "" Then Exit Sub
    s = Split(x & " ")
    deb = IIf(s(0) < s(1), s(0), s(1))
    fin = IIf(s(0) > s(1), s(0), s(1))
Loop While Not IsDate(deb) Or Not IsDate(fin)
If CDate(fin) - CDate(deb) > 9999 Then MsgBox "Le nombre de jours ne doit pas dépasser 10000 !", 48: Exit Sub
Set P = [B2:C5] 'tableau initial
i = 1
Application.ScreenUpdating = False
For dat = CDate(deb) To CDate(fin)
    If i > 1 Then P.Copy P(i, 1) 'copier-coller
    P(i, 1) = UCase(Format(dat, "dddd"))
    P(i, 2) = Day(dat)
    P(i + 1, 1) = UCase(Format(dat, "mmmm yyyy"))
    i = i + 4
Next
P(i, 1).Resize(Rows.Count - P(i, 1).Row + 1, 2).Clear 'RAZ en dessous
If ActiveSheet.Name = Me.Name Then Worksheet_Activate Else Me.Activate 'lance la macro Worksheet_Activate
End Sub