[XL-2010] Paste Special erreur

[ToFind]

Bonjour,
Voici mon souci. Je reçois le message d'erreur "La méthode PasteSpecial de la classe Range a échoué".
Voici le code :

Code :

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
 
 
Sub MacroFusionCell()
'
    ActiveSheet.Unprotect
 
 i = ActiveCell.Row
 
    ' Désactive la mise à jour d'écran
    Application.ScreenUpdating = False
 
     Range("G9:J9").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.Merge
    Selection.Copy
    Range("G10:J2036").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
 
    Range("A9:J2036").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
 
    Range("A" & i).Select
 
        ' Active la mise à jour d'écran
    Application.ScreenUpdating = True
End Sub

Ce code ne posait pas de problème avant que je place le code suivant sur la feuille

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
'Option Explicit
 
Dim p As Integer 'Variable pour le test
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect
Dim p As Long
p = ActiveCell.Row
' Vérifier si la cellule active ne se trouve pas sur une ligne inférieure à 8
    If ActiveCell.Row > 8 Then
 
         If EstVide(Range("A" & p)) Then
         Range("L2").Copy Range("L" & p)
         Else
         Range("L" & p) = ""
 
         End If
 
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
 
End Sub

Pouvez-vous m'aider à comprendre ce qui se passe et à solutionner?

Merci.

[Gestionnaire_rh]

Bonjour,

je constate une erreur sur la ligne 12 de ton second code:

Code :

If EstVide(Range("A" & p)) Then

essaye de le remplacer par ça:

Code :

If IsEmpty(Range("A" & p)) Then

Cordialement

Gestionnaire rh

[gFZT82]

Bonjour,

Tu as rajouté l’évènement Worksheet_SelectionChange.
A chaque changement de sélection, la procédure liée à cet évènement sera exécutée. Or, dans le corps de ta procédure MacroFusionCell, tu as plusieurs sélections qui vont provoquer cet évènement et qui vont « perturber » le traitement attendu.

Tu peux utiliser la propriété Application.EnableEvents=false pour désactiver l’événement Worksheet_SelectionChange en début de ta procédure puis Application.EnableEvents=True en fin de procédure pour le réactiver.

Cordialement.

[ToFind]

Merci, j'ai ajouté Application.EnableEvents=false et Application.EnableEvents=True et cela fonctionne.

Mon code de la feuille est cependant erroné et le résultat escompté n'est pas obtenu.

En réalité, ce que je souhaite est ceci :

Dans la feuille, si je me trouve sur une ligne > 8 et que la cellule ("A" & p) est vide, il faut vider ("L" & p).
Par contre si (et seulement si) ("A" & p) est modifié et non vide, il faut copier ("L2") dans ("L" & p).

Avez-vous une piste?

[gFZT82]

Bonjour,

Tu peux combiner les actions avec les 2 événements Worksheet.Change et Worksheet.SelectionChange.

Worksheet_Change te permet d’effectuer la copie de L2 suivant la condition « si et seulement si ("A" & p) est modifié et non vide » car l’événement se produit lorsque les cellules de la feuille de calcul sont modifiées.

Worksheet.SelectionChange te permet de vider ("L" & p) si la cellule ("A" & p) est vide car l’événement survient lorsque la sélection change dans la feuille de calcul.

Cordialement