Copy Titre

[maval]

Bonsoir,


Voila j'ai une macro qui copie et colle le titre de la feuille sur un autre feuille le code est ceci.

Sub copy()
Sheets(4).Range("K1", Range("K1").End(xlDown)).copy
Sheets("BD").Range("K1").PasteSpecial Paste:=xlPasteValues

 With Range("k1")
      '
             .Font.Bold = True
             .Font.Size = 28
             .Font.Italic = True
             .Font.Underline = True
             .Font.Color = RGB(0, 96, 0)
         End With
End Sub

Le seul problème est que sa colle uniquement sur la feuille nommer "BD" et j'aimerai que sa colle sur n'importe quelle feuille au choix de l'utilisateur.

Merci d'avance

 

[Staple1600]

Re : Copy Titre

Bonsoir à tous

maval
Une façon de faire

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

 

[Staple1600]

Re : Copy Titre

Bonjour à tous

maval
Maintenant que je sais que tu l'as vu 😉
Tu peux me dire si ma proposition te convient ?

 

[job75]

Re : Copy Titre

Bonsoir maval, JM,

@ JM maval ne te répond pas peut-être parce que ton InputBox elle est moche 😉

Alors je tente ma chance avec un UserForm, c'est plusse beau 🙄

Le code dans ThisWorkbook :

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

Le code dans l'USF :

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

Fichier joint.

Bonne soirée.

 

[Staple1600]

Re : Copy Titre

Bonsoir job75

job75
Elle est ni moche, ni belle, elle vivait juste sa vie d'InpuBox dans l'anonymat jusqu'à maintenant 😉

 

[maval]

Re : Copy Titre

Bonsoir JM

Je te remercie nickel

Bonne soirée