Simplification de procédure
Résolu
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.
2 réponses
-
Bonjour
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) :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 :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 !
-
