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