Sujet Précédent Sujet Suivant

Simplification de procédure

Résolu/Fermé
Villette54 Messages postés 300 Date d'inscription vendredi 15 mars 2013 Statut Membre Dernière intervention 31 juillet 2018 - Modifié par Villette54 le 20/10/2014 à 12:18
Villette54 Messages postés 300 Date d'inscription vendredi 15 mars 2013 Statut Membre Dernière intervention 31 juillet 2018 - 21 oct. 2014 à 16:42
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). 

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

Réponse 1 / 2
ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
20 oct. 2014 à 13:40
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
0
Réponse 2 / 2
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
Modifié par Patrice33740 le 20/10/2014 à 14:10
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
0
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
Modifié par Patrice33740 le 20/10/2014 à 14:10
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
0
Villette54 Messages postés 300 Date d'inscription vendredi 15 mars 2013 Statut Membre Dernière intervention 31 juillet 2018 28
Modifié par Villette54 le 21/10/2014 à 16:42
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 !
0

Discussions similaires

Point d'entrée introuvable
sam -
Riri41 -

9 réponses
point d'entrée de procédure introuvable
lamarche dominique -
Pat28 -

7 réponses
Point d'entrée introuvable dans KERNEL32.dll
Anthony -
VrOMAX -

8 réponses
arnaque a l'héritage cote ivoire
fredispo -
mpmp93 -

6 réponses
Point d'entrée de procédure introuvable dans la bibliothèque de liens dynamiques
Lauw238 -
Malekal_morte- -

18 réponses