Copy Titre

Sub CopyII()
Dim Titre As Range, x As Worksheet
Set Titre = Sheets(4).Range("K1"): Set x = Sheets(Titre.Parent.Name).Previous
Destination = InputBox("Saisir le nom de la feuille où copier le titre", "Copie Titre", x.Name)
Titre.copy: Sheets(Destination).Range("K1").PasteSpecial Paste:=xlPasteAll
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim w As Worksheet
If Sh.CodeName = "Feuil4" And Not Intersect(Source, Sh.[K1]) Is Nothing Then
  For Each w In Worksheets
    'le nom est défini dans la feuille, pas dans le classeur
    If w.CodeName <> Sh.CodeName Then w.Names.Add "titre", True
  Next
End If
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not IsError([titre]) Then UserForm1.Show
End Sub

Private Sub CheckBox1_Click()
If CheckBox1 Then CheckBox2 = True
End Sub

Private Sub UserForm_QueryClose(cancel As Integer, closemode As Integer)
If CheckBox1 Then Feuil4.[K1].copy [K1]
If CheckBox2 Then ActiveSheet.Names("titre").Delete
End Sub