Bonjour,
je ne suis vraiment pas très bon en Excel et je n'arrive pas à faire fonctionner mon code,..
Je ne sais pas si je l'ai bien démarrer ou tout est faux en tout cas il y a déjà un début !
le but de mon programme est lorsque j'effectue un clic droit sur un produit dans mon planning celui-ci m'envoie dans ma feuille d'apparition toutes les caractéristiques de ce produit. Il suffit pour cela d'extraire entièrement la ligne de ces caractéristiques (se trouvent dans la feuille tableau à extraire) et les colles dans la feuille d'apparition en dessous de l'entête déjà présente.
je ne suis vraiment pas très bon en Excel et je n'arrive pas à faire fonctionner mon code,..
Je ne sais pas si je l'ai bien démarrer ou tout est faux en tout cas il y a déjà un début !
le but de mon programme est lorsque j'effectue un clic droit sur un produit dans mon planning celui-ci m'envoie dans ma feuille d'apparition toutes les caractéristiques de ce produit. Il suffit pour cela d'extraire entièrement la ligne de ces caractéristiques (se trouvent dans la feuille tableau à extraire) et les colles dans la feuille d'apparition en dessous de l'entête déjà présente.
VB:
Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Dim rLignes As Range, rCols As Range, plage As Range, c As Range
Dim ref As String
Dim cell As Range
Set rLignes = Union(Rows("15"), Rows("20"), Rows("25"), Rows("30"), Rows("35"), Rows("40"), Rows("45"), Rows("50"), Rows("55"), Rows("60"))
Set rCols = Range("E:E, G:G, I:I, K:K, M:M")
Set plage = Intersect(rLignes, rCols)
If Not Intersect(Target, plage) Is Nothing Then
If Target.Value <> "" Then
ref = Target.Value
Else
MsgBox "Référence incorrecte"
Exit Sub
End If
With Worksheets("tableau à extraire").Range("A1:A134")
Set cell = Feuil4.Columns(1).Target.Value
If Not cell Is Nothing Then
cell.Copy Destination:=Sheets("Feuil5").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 'code copie de ligne à insérer ici
Else
MsgBox "Référence inexistante"
Exit Sub
End If
End With
End If
End Sub