copie de ligne sous condition

rudymagny

XLDnaute Occasionnel
Bonsoir le forum!

J'ai un ti problème sur une copie de ligne si double clic sur une cellule avec le code suivant:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Déclaration des variables pour export vers feuilles signature E5
Dim li As Integer 'déclare la variable li
Dim dest As Range 'déclare la variable dest
Dim clas As Workbook 'déclare la variable clas
'/////////////////////////////////////////////////////////////////////////
'Condition pour gérer les cases à cocher
If Target.Value Like '[oý]' Then
Target.Value = IIf(Target.Value = 'o', 'ý', 'o')
'Empêche la sélection de la cellule après le double-clic
Cancel = True
End If
'/////////////////////////////////////////////////////////////////////////
'ouverture du classeur pour la suite du code sinon fonctionne pa
ThisWorkbook.FollowHyperlink 'D:\\RTE\\Essais E4_VCT\\Suivi\\2006\\Signature E5.xls'

'Code pour exporter la ligne dans l'autre feuille et l'onglet 'Signature E5'
Set clas = Workbooks('Signature E5.xls') 'définit la variable clas

'si le double click n'a pas lieu dans une cellule éditée de la colonne AE, sort de la procédure
If Application.Intersect(Target, Range('AE4:AE' & Range('AE65536').End(xlUp).Row)) Is Nothing Then Exit Sub

ActiveSheet.Unprotect

li = Target.Row 'définit la variable li

'définit la variable dest
With clas.Sheets('Signature E5') 'prend en compte l'onglet 'Signature E5'
If .Range('B4').Value = '' Then 'condition 2 : si A1 est vide
Set dest = .Range('B4') 'définit la variable dest
Else 'sinon
Set dest = .Range('B65536').End(xlUp).Offset(1, 0) 'définit la variable dest
End If 'fin de la condition 2
With .Range('AB' & li)
.Value = 'o'
.Font.Name = 'Wingdings'
End With
End With 'fin de la prise en compte de l'onglet 'Extract Signature E5'

'copie la ligne de la case cochée de l'onglet en cours et la colle dans l'onglet 'Signature E5' de l'autre feuille
Range(Cells(li, 2), Cells(li, 27)).Copy Destination:=dest
End Sub

Le fait est que lorsque je double clic sur la première cellule, il m'ouvre bien le fichier 'Signature E5.xls' et me copie la ligne dans la bonne zone mais si je double clic sur une autre cellule pour copier la ligne, il ne me la copie pas dans l'autre classeur 'Signature E5.xls'
je suis bloqué et je vois po pourkoi :angry:

Merci d'avance
 

rudymagny

XLDnaute Occasionnel
j'ai trouver une manière de détourner le problème en remplacant :
If Application.Intersect(Target, Range(\\'AE4:AE\\' & Range(\\'AE65536\\').End(xlUp).Row)) Is Nothing

par ça:

If Application.Intersect(Target, Range('AE4:AE20000')) Is Nothing Then exit sub

le fait est qu'il ne fonctionnait qu'avec la cellule AE4 et pas les cellule en dessous!
Enfin voilà
 

Discussions similaires

Statistiques des forums

Discussions
312 489
Messages
2 088 852
Membres
103 975
dernier inscrit
denry