Discussion :

[patmicro]

Bonjour à tous les lecteurs du forum.
Dans une feuille nommée (Données) J’ai des prénoms de personnes en colonne (L) représenté par les lettres pour l’exemple.
Dans une autre feuille nommée (calendrier) je désire copier par exemple un prénom de la colonne (L) de la feuille (Données) dans des cellules de mon choix par macro en ayant préalablement sélectionner les cellules de mon choix. Cela peut être une seule cellule ou plusieurs cellules en colonne dont celles-ci seront fusionnées. La couleur des prénoms en colonne (L) doit être reproduite dans le calendrier
La macro ci-joint fonctionne avec une seule cellule sélectionnée mais pas avec plusieurs cellules
Ci-joint copies d’écran et code.
Nota le codage désactivé correspond à l’ancien codage qui fonctionnait parfaitement
Les codes couleurs en colonne (L) ont disparu mais correspondent aux codes couleurs colonne (K)
Par avance merci pour votre aide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub Vacances_Louis()
'
' Vacances_Louis Macro
''
ActiveSheet.Unprotect
'Coloration
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    'End With
    Selection.Merge 'fusion des cellules s?lectionn?es
    'With Selection.Interior
        '.Pattern = xlSolid
        '.PatternColorIndex = xlAutomatic
        '.Color = 49407
        ''.Color = RGB(250, 191, 143)
        '.TintAndShade = 0
        '.PatternTintAndShade = 0
    End With
 
    'S?lection du pr?nom sur la feuille donn?es en L
'Copier
 
'Modification du code
 
  Sheets("Donn?es").Select
    Range("L5").Select
    Selection.Copy
    Sheets("Calendrier").Select
 
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Calendrier").Select
 
    Selection.Locked = False
    Selection.FormulaHidden = False
 
  'Ancien code
    ''Selection.Merge
    'ActiveCell.Range("A1:A2").Select
    'ActiveCell.FormulaR1C1 = "Romuald"
    'ActiveCell.Range("A1:A2").Select
 
    ActiveSheet.Protect
    ActiveWorkbook.Save
 
End Sub

[Thautheme]

Bonsoir Patmicro, bonsoir le forum,

Peut-être comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Vacances_Louis()
Dim PL As Range
 
Set PL = Selection
ActiveSheet.Unprotect
With PL
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
End With
Sheets("Données").Range("L5").Copy PL
PL.Interior.Color = Sheets("Données").Range("L5").Interior.Color
ActiveSheet.Protect
ActiveWorkbook.Save
End Sub

[patmicro]

Bonsoir Thautheme : Un grand merci pour ce service, cela fonctionne presque parfaitement.

Est il possible lors de la copie lors de la validation de sélectionner la cellule du dessous et non celle située vers la droite ?
Lorsque deux ou plusieurs cellules sont sélectionnées celles ci sont verrouillées alors quelles ne le sont pas au départ, alors que si une seule cellule est sélectionnée celle ci n'est pas verrouillée.

J'ai trouvé la solution en rajoutant après

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
End With
Selection.Locked = False

[Thautheme]

Re,

Est il possible lors de la copie lors de la validation de sélectionner la cellule du dessous et non celle située vers la droite ?

Désolé mais j'ai pas compris. Pourrais-tu me proposer un exemple...

[patmicro]

Bonjour Thautheme : Voici une copie d'écran Lors de l'action la cellule immédiatement à droite (tiret rouge) était sélectionnée alors que je voulais quel reste sur la cellule Active cercle rouge.

J'ai rajouté l'instruction Selection.Locked = False / après le End with

[Thautheme]

Re,

Je ne comprends pas. Chez moi c'est bien la cellule fusionnée qui reste sélectionnée... Quand tu protèges l'onglet, n'y aurait-il pas un critère qui provoque ce déplacement de la cellule active ?...

[patmicro]

Re: Oui bizard après avoir fermé puis ouvert de nouveau cela fonctionne même après avoir désactivé la ligne que j'avais ajouté

Merci de ta participation

Problème résolu