double click et suppression de ligne avec Find

gvives

XLDnaute Occasionnel
Bonjour à tous j'ai un fichier avec une feuil1 et une feuil2.

Je souhaite pouvoir copier coller des lignes de la feuil1 à la feuil2 grâce au double click (double click = copie vers la dernière ligne vide de la feuil2, et redoubleclick suppression de la ligne créée grâce a la fonction find).

J'ai un code mais je ne connait pas la fonction Copy, Find et ne sais pas comment copier sur une dernière ligne non vide


Pouvez vous me donner un coup de mains pour ce code ...

Private Sub Worksheet_beforedoubleclick(ByVal target As Range, cancel As Boolean)

With target

If .Column = 10 And .Row > 1 Then

If target = "" Then
target.Value = "P"
Else
target.Value = ""
End If

End If

If .Column = 10 And .Row > 1 Then

If target.Value = "" Then
target.EntireRow.Copy 'dans la dernière ligne non vide de la colonne B de la feuille 2
Else
Find 'target.Offset(0,-7).Value dans la feuille2 et supprimer la ligne correspondante
End If

End If

End With

End Sub

Merci beaucoup d'avance !!
 

kjin

XLDnaute Barbatruc
Re : double click et suppression de ligne avec Find

Bonjour,
Pas très clair d'autant que l'on a pas le fichier exemple...!
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 10 Or Target.Row < 1 Then Exit Sub
Cancel = True
Target = IIf(Target = "", "P", "")
If Target <> "" Then
    With Feuil2
        Set c = .Columns(3).Find(Target.Offset(0, -7))
        If Not c Is Nothing Then c.EntireRow.Delete
        dl = .Range("A65000").End(xlUp).Row + 1
        Target.EntireRow.Copy .Cells(dl, 1)
    End With
End If
End Sub
A+
kjin
 

job75

XLDnaute Barbatruc
Re : double click et suppression de ligne avec Find

Bonjour gvives,

La méthode Find pose parfois des problèmes, je préfère utiliser Match :

Code:
Private Sub Worksheet_beforedoubleclick(ByVal Target As Range, Cancel As Boolean)
'Feuil2 CodeName de la feuille de destination
If Target.Column = 10 And Target.Row > 1 Then
  Dim lig As Variant
  Cancel = True
  If Target = "" Then
    Target = "P"
    Target.EntireRow.Copy Feuil2.[B65536].End(xlUp)(2).EntireRow
  Else
    Target = ""
    lig = Application.Match(Target(1, -6), Feuil2.[C:C], 0)
    If IsNumeric(lig) Then Feuil2.Rows(lig).Delete
  End If
End If
End Sub
Edit : bonjour kjin, je ne t'avais pas vu :)

A+
 
Dernière édition:

gvives

XLDnaute Occasionnel
Re : double click et suppression de ligne avec Find

Bonjour Job75,
Bonjour Kjin,

Merci beaucoup ça marche, j'ai simplement un petit soucis car je souhaiterais adapter la zone à copier de la façon suivante :

Target.Range("AA"&Row:"AS"&Row).Copy

Je sais c'est pas top mais je n'arrive jamais avec les ranges grrr en gros la zone part de AA à AS sur la ligne target...

Pourriez vous m'aider ;)
 

job75

XLDnaute Barbatruc
Re : double click et suppression de ligne avec Find

Re,

Si je comprends bien votre post #4, vous voulez copier entre les colonnes AA et AS, mais alors :

1) en Feuil2 on colle sur quelle cellule ?

2) en Feuil2 dans quelle colonne fait-on ensuite la recherche ?

A+
 

gvives

XLDnaute Occasionnel
Re : double click et suppression de ligne avec Find

Effectivement Job75, mon commentaire est très maladroit :/ je m'en excuse...

J'ai utilisé votre code car il se rapproche plus du miens et que je le comprend mieux... Mais je vais biensur travailler celui de Kjin pour élargir mes connaissances en VBA.

Pour mon post 4 :

Je souhaiterai copier la feuil1 colonne AA à AS sur la feuil2 colonne B à T
et comparer la colonne AA feuil1 avec la colonne B feuil2 pour la suppression de ligne

J'espère être assez précis...

Merci beaucoup pour votre aide ;)
 

job75

XLDnaute Barbatruc
Re : double click et suppression de ligne avec Find

Re,

Oui maintenant tout est clair.

Il y a 19 colonnes de AA à AS :

Code:
Private Sub Worksheet_beforedoubleclick(ByVal Target As Range, Cancel As Boolean)
'Feuil2 CodeName de la feuille de destination
If Target.Column = 10 And Target.Row > 1 Then
  Dim lig As Variant
  Cancel = True
  If Target = "" Then
    Target = "P"
    Cells(Target.Row, "AA").Resize(, 19).Copy Feuil2.[B65536].End(xlUp)(2)
  Else
    Target = ""
    lig = Application.Match(Cells(Target.Row, "AA"), Feuil2.[B:B], 0)
    If IsNumeric(lig) Then Feuil2.Rows(lig).Delete
  End If
End If
End Sub
A+
 

Discussions similaires

Réponses
1
Affichages
248

Statistiques des forums

Discussions
312 294
Messages
2 086 950
Membres
103 404
dernier inscrit
sultan87