Copie/colle une ligne entière de données

Bonjour à vous,

j'ai un problème avec mon programme,...

Le but de mon programme est d'extraire une ligne d'une tableau à l'aide d'un critère en faisant un Click droit sûr celui-ci. Cette extraction doit être recopier dans une autre feuille bien sûr je souhaiterai que si je Click sur un autre critère il me le copie en dessous de celui d'avant. Pour l'instant je voudrai déjà pouvoir coller mon extraction de ligne sûr une autre feuille,... pouvez vous m'aider ?

Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Dim colE As Range
Dim colG As Range
Dim colI As Range
Dim colK As Range
Dim colM As Range
Dim plage As Range
Dim ref As String
Dim c As Range

Set colE = Application.Union(Range("E15"), Range("E20"), Range("E25"), Range("E30"), Range("E35"), Range("E40"), Range("E45"), Range("E50"), Range("E55"), Range("E60"))
Set colG = Application.Union(Range("G15"), Range("G20"), Range("G25"), Range("G30"), Range("G35"), Range("G40"), Range("G45"), Range("G50"), Range("G55"), Range("G60"))
Set colI = Application.Union(Range("I15"), Range("I20"), Range("I25"), Range("I30"), Range("I35"), Range("I40"), Range("I45"), Range("I50"), Range("I55"), Range("I60"))
Set colK = Application.Union(Range("K15"), Range("K20"), Range("K25"), Range("K30"), Range("K35"), Range("K40"), Range("K45"), Range("K50"), Range("K55"), Range("K60"))
Set colM = Application.Union(Range("M15"), Range("M20"), Range("M25"), Range("M30"), Range("M35"), Range("M40"), Range("M45"), Range("M50"), Range("M55"), Range("M60"))
Set plage = Application.Union(colE, colG, colI, colK, colM)

If Not Intersect(Target, plage) Is Nothing Then
    If Target > "" Then
       ref = Target.Value
    Else
        MsgBox "Référence incorrecte"
        Exit Sub
    End If

With Worksheets("tableau à extraire").Range("A1:A15") ' problème avec feuille 4, zone restreinte pour le test
    Set c = .Find(ref, LookIn:=xlValues)
    If Not c Is Nothing Then
    MsgBox "Référence existante"

    c.Copy
    Sheets("Feuil5").Select
    Range("A3").Select
    ActiveSheet.Paste

               '  code copie de ligne à insérer ici

     Else
     MsgBox "Référence inexistante"
    End If
End With
    Else
    ' a définir
    End If
End Sub

Bonjour,

Voici un essai, en insérant à la ligne après la dernière ligne non vide :

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

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:A15") ' problème avec feuille 4, zone restreinte pour le test
        Set c = .Find(ref, LookIn:=xlValues)
        If Not c Is Nothing Then
            c.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

Edit : vos colonnes E à M contiennent-elles des cellules fusionnées ?

Cdlt,

boujour 3GB,

merci pour ta réponse cependant ton code ne fonctionne pas avec mon fichier Excel et je ne comprend pas pourquoi, saurait -tu pourquoi il ne fonctionne pas ? car il me met qu'avec le code de copie il y a une erreur de type 9 (indice n'appartenant pas à la selection)

Bonjour,

A quelle ligne se trouve l'erreur (il faut ouvrir l'éditeur pour le savoir) ?

J'ai pris les éléments qu'il y avait sur ton code. Est-ce que les feuilles "tableau à extraire" et "Feuil5" existent bien avec ces noms correctement libellés ? J'ai vu un commentaire au sujet d'une feuille 4 dans le code...