Appliquer code VBA d'une ligne aux autres lignes Résolu/Fermé

Question

Bonjour, 

Après des recherches qui me faisait avancer tant bien que mal, me voila maintenant bloqué.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Not Application.Intersect(Target, Range("A4")).End(xlUp) Is Nothing ThenSheets("EtiquetteClique").Range("B5") = Sheets("Tableau").Range("D4")Sheets("EtiquetteClique").Range("B6") = Sheets("Tableau").Range("E4")Sheets("EtiquetteClique").Range("B7") = Sheets("Tableau").Range("F4")Sheets("EtiquetteClique").Range("B8") = Sheets("Tableau").Range("G4")Sheets("EtiquetteClique").Range("B9") = Sheets("Tableau").Range("I4")End IfEnd Sub

Ce code fonctionne et me permet de remplir les cellules voulu dans ma feuille "EtiquetteClique" quand je double clique sur ma cellule A4 de ma feuille "Tableau".
Je voudrais que ce code s'applique par la suite à la ligne A7, A10, A13...mais toujours pour remplir les mêmes cellules sur ma feuille "EtiquetteClique".

J'ai essayé avec un ElseIf mais quand je double clique sur ma deuxième ligne j'ai le message suivant : "erreur 91 : variable objet ou de bloc With non définie".
Par la suite j'ai testé avec un Switch ou Selection.AutoFill Destination mais sans résultat concluant.

Merci d'avance pour l'attention que vous pourrez porter à mon problème.

Frenchie83 · Answer

Bonjour
2 solutions
la première avec un test uniquement sur  A4, A7,A10, A13
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Application.Intersect(Target, Range("A4,A7,A10,A13")) Is Nothing Then
        Sheets("EtiquetteClique").Range("B5") = Sheets("Tableau").Range("D4")
        Sheets("EtiquetteClique").Range("B6") = Sheets("Tableau").Range("E4")
        Sheets("EtiquetteClique").Range("B7") = Sheets("Tableau").Range("F4")
        Sheets("EtiquetteClique").Range("B8") = Sheets("Tableau").Range("G4")
        Sheets("EtiquetteClique").Range("B9") = Sheets("Tableau").Range("I4")
    End If
End Sub

Une deuxième avec un test sur toutes les cellules A4, A7,A10, A13, A16, A19 etc..
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If (ActiveCell.Row - 4) Mod 3 = 0 And ActiveCell.Column = 1 And ActiveCell.Row > 1 Then
        Sheets("EtiquetteClique").Range("B5") = Sheets("Tableau").Range("D4")
        Sheets("EtiquetteClique").Range("B6") = Sheets("Tableau").Range("E4")
        Sheets("EtiquetteClique").Range("B7") = Sheets("Tableau").Range("F4")
        Sheets("EtiquetteClique").Range("B8") = Sheets("Tableau").Range("G4")
        Sheets("EtiquetteClique").Range("B9") = Sheets("Tableau").Range("I4")
    End If
End Sub
cdlt

BFusien · Answer

Bonjour Frenchie83,

Merci pour ton aide, ta 2ème solution me convient parfaitement.
Je l'ai un peu modifiée et ça fonctionne comme il faut.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim MaLig As LongMaLig = Target.RowIf Target.Column <> 1 Then Exit Sub  If Not Application.Intersect(Target, Cells(MaLig, 1)).End(xlUp) Is Nothing Then   ' le double clic sur une ligne sélectionne certaine cellule de cette ligne via leur numéro de colonne et les copies aux endroits désignés (ici sur une autre feuille)   Sheets("EtiquetteClique").Range("D4") = Sheets("Tableau").Cells(MaLig, 1)   Sheets("EtiquetteClique").Range("B5") = Sheets("Tableau").Cells(MaLig, 4)   Sheets("EtiquetteClique").Range("B6") = Sheets("Tableau").Cells(MaLig, 5)   Sheets("EtiquetteClique").Range("B7") = Sheets("Tableau").Cells(MaLig, 6)   Sheets("EtiquetteClique").Range("B8") = Sheets("Tableau").Cells(MaLig, 7)   Sheets("EtiquetteClique").Range("B9") = Sheets("Tableau").Cells(MaLig, 9)End IfEnd Sub

Appliquer code VBA d'une ligne aux autres lignes

2 réponses

Discussions similaires