[XL-2019] Macro qui fait gelé Excel

1 pièce(s) jointe(s)

Macro qui fait gelé Excel

Bonjour,

Je travaille sur une macro qui vérifie la cellule E7 d'une feuille prédéterminée afin d'effacer ou faire apparaître des résultats. Ma cellule E7 contient une liste déroulante. Quand je la teste, elle fait geler Excel. Pourriez-vous m'aider à comprendre pourquoi? Qu'est-ce qui ne va pas à mon code? Je vous laisse mon code et une capture d'écran.

Merci d'avance pour votre aide.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Option Compare Text Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Worksheets("Journée") If (.[E7]) <> "" Then Range("I7:P7").Select Selection.ClearContents Range("E6").Select Else .[I7].Value = .[R7].Value .[J7].Value = .[S7].Value .[K7].Value = .[T7].Value .[L7].Value = .[U7].Value .[M7].Value = .[V7].Value .[N7].Value = .[W7].Value .[O7].Value = .[X7].Value .[P7].Value = .[Y7].Value End If End With End Sub
Pièce jointe 571756

Citation:

Envoyé par Miraie

Bonjour,

Essayez plutôt avec l'événement Worksheet_Change :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
        If Target.Count > 1 Then Exit Sub
 
        If Not Intersect(Target, [E7]) Is Nothing Then
           If [E7] <> "" Then
              [I7:P7].ClearContents
           Else
              [I7].Value = [R7].Value
              [J7].Value = [S7].Value
              [K7].Value = [T7].Value
              [L7].Value = [U7].Value
              [M7].Value = [V7].Value
              [N7].Value = [W7].Value
              [O7].Value = [X7].Value
              [P7].Value = [Y7].Value
           End If
        End If
 
End Sub

Merci, Eric KERGRESSE, cela fonctionne à merveille!

Bonjour,
On pourrait également remplacer les lignes 11 à 18 par
Code:

1 2 3 For c = 9 To 16 Cells(7, c).Value = Cells(7, c + 9).Value Next
sans omettre de déclarer la variable c en début de procédure

ou encore plus court s'il n'y a pas de format différent entre les deux plages

Code:

Range("R7:Y7").Copy Destination:=Range("I7")

Merci, Philippe Tulliez, je vais surment modifer mon script avec tes conceils.