Simplification de procédure
Résolu
Villette54
Messages postés
300
Date d'inscription
Statut
Membre
Dernière intervention
-
Villette54 Messages postés 300 Date d'inscription Statut Membre Dernière intervention -
Villette54 Messages postés 300 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
J'aurais souhaité savoir s'il était possible de simplifier un peu cette procedure ?
Elle n'est pas compliqué en soit, elle fonctionne très bien mais c'est juste qu'elle est très lourde (et un peu répétitive).
Merci d'avance.
J'aurais souhaité savoir s'il était possible de simplifier un peu cette procedure ?
Elle n'est pas compliqué en soit, elle fonctionne très bien mais c'est juste qu'elle est très lourde (et un peu répétitive).
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C2")) Is Nothing Then
Range("X2") = Range("C2")
Range("C3:C14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("D2")) Is Nothing Then
Range("X2") = Range("D2")
Range("D3:D14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("E2")) Is Nothing Then
Range("X2") = Range("E2")
Range("E3:E14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("F2")) Is Nothing Then
Range("X2") = Range("F2")
Range("F3:F14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("G2")) Is Nothing Then
Range("X2") = Range("G2")
Range("G3:G14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("H2")) Is Nothing Then
Range("X2") = Range("H2")
Range("H3:H14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("I2")) Is Nothing Then
Range("X2") = Range("I2")
Range("I3:I14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("J2")) Is Nothing Then
Range("X2") = Range("J2")
Range("J3:J14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("K2")) Is Nothing Then
Range("X2") = Range("K2")
Range("K3:K14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("L2")) Is Nothing Then
Range("X2") = Range("L2")
Range("L3:L14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("M2")) Is Nothing Then
Range("X2") = Range("M2")
Range("M3:M14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("N2")) Is Nothing Then
Range("X2") = Range("N2")
Range("N3:N14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("O2")) Is Nothing Then
Range("X2") = Range("O2")
Range("O3:O14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("P2")) Is Nothing Then
Range("X2") = Range("P2")
Range("P3:P14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("Q2")) Is Nothing Then
Range("X2") = Range("Q2")
Range("Q3:Q14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("R2")) Is Nothing Then
Range("X2") = Range("R2")
Range("R3:R14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("S2")) Is Nothing Then
Range("X2") = Range("S2")
Range("S3:S14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("T2")) Is Nothing Then
Range("X2") = Range("T2")
Range("T3:T14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("U2")) Is Nothing Then
Range("X2") = Range("U2")
Range("U3:U14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
If Not Intersect(Target, Range("V2")) Is Nothing Then
Range("X2") = Range("V2")
Range("V3:V14").Copy
Range("X3:X14").PasteSpecial xlFormats
End If
Application.CutCopyMode = False
End Sub
Merci d'avance.
A voir également:
- Simplification de procédure
- Point d'entrée de procédure introuvable kernel32.dll windows 7 ✓ - Forum Windows
- Le point d'entrée de procédure iswow64process2 est introuvable - Forum Windows
- Le point d'entrée de procédure est introuvable dans la bibliothèque de liens dynamiques ✓ - Forum Logiciels
- Le point d'entrée de procédure eventsetinformation est introuvable advapi32.dll - Forum Windows
- Le point d'entrée de procédure discard virtual memory est introuvable ✓ - Forum Windows
2 réponses
Bonjour
Essaies ceci
Essaies ceci
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim plage As Range, co As Long
If Not Intersect(Target, Range("C2:V2")) Is Nothing Then
Range("X2") = Target.Value
co = Target.Column
Set plage = Range(Cells(3, co), Cells(14, co))
'plage.Select
plage.Copy
Range("X3:X14").PasteSpecial xlFormats
End If
Cdlmnt
End Sub
Bonjour.
Ou encore (sans variable supplémentaire) :
Cordialement
Patrice
Ou encore (sans variable supplémentaire) :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("C2:V2")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Range("X2").Value = Target.Value
Target.Offset(1).Resize(12).Copy
Range("X3:X14").PasteSpecial xlFormats
Application.CutCopyMode = False
End Sub
Cordialement
Patrice
Désolé, je n'avais pas envisagé la sélection de plusieurs cellules
Voici un code pour ce cas :
Edit : correction 12 lignes et non 12 colonnes
Voici un code pour ce cas :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cel As Range
If Intersect(Target, Range("C2:V2")) Is Nothing Then Exit Sub
For Each cel In Target.Rows(1).Cells
Range("X2").Value = cel.Value
cell.Offset(1).Resize(12).Copy
Range("X3:X14").PasteSpecial xlFormats
Next cel
Application.CutCopyMode = False
End Sub
Edit : correction 12 lignes et non 12 colonnes
Bonjour,
Merci pour vos réponses, effectivement vos solutions sont beaucoup plus simple !
ccm81, ta solution fonctionne très bien. Je te remercie.
Patrice33740, ta proposition fonctionne également mais je ne connais pas la fonction "offset" c'est pourquoi j'ai préféré la solution de ccm81. Quoi qu'il en soit un grand merci aussi.
Bonne fin de journée !
Merci pour vos réponses, effectivement vos solutions sont beaucoup plus simple !
ccm81, ta solution fonctionne très bien. Je te remercie.
Patrice33740, ta proposition fonctionne également mais je ne connais pas la fonction "offset" c'est pourquoi j'ai préféré la solution de ccm81. Quoi qu'il en soit un grand merci aussi.
Bonne fin de journée !
