Beug sur code VBA copier/coller

Bonjour ,

Avec le code ci-dessous je cherche a copier par double clic séparément chaque cellule de la plage H17:N17 et les coller dans la plage D1:R15 ,mais je beug quelque part.Ou se trouve mon erreur?

Merci pour votre aide

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Cancel = True
If Not Intersect(Target, Range("H17:N17")) Is Nothing And Target <> "" Then Target.Offset , ("D4:R15")
'
End Sub

Bonjour

Essaie ça :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Cancel = True
    If Not Intersect(Target, Range("H17:N17")) Is Nothing And Target <> "" Then
        Range("H17:N17").Copy Range("D4")
    End If
End Sub

Bye !

Bonsoir gmb

Merci pour ton aide

Désolé cela ne fonctionne pas ce qu'il faut c'est que je copie une cellule entre H17:N17 et que je la colle ou je veux c'est a dire n'importe ou dans

la plage D1:R15 (mes excuses pour le D4 dans ma demande)

Salut,

Si j'ai bien compris le double clic se fait sur la cellule qui doit recevoir les données.

Par contre ce que je ne comprends pas H17:N17 cela fait 7 cellules à copier dans D1:R15 à copier individuellement alors là

Bonsoir Jean Paul

Le double clic se fait sur la cellule a copier

Effectivement il s'agit de prendre par exemple H17 de le copier et le coller dans une cellule la plage D1:R15

je ne sais pas quelle cellule a l'avance.

Salut,

Hum, donc double clic, la cellule s'envole, reste en suspend au dessus de D1:R15 en attendant de savoir ou elle devra se poser.

Des cellules divinatoires, ça existe cela sous Excel ?

Bonjour le fil

Si j'ai bien compris Une possibilité avec le presse papier

A+

Bonjour Bruno,

Je vais tester et je te tiens au courant

Merci pour ton aide

Crdlt

Re bonjour Bruno,

J'ai légèrement modifié il y a 2 beugs ici

Call ClipObtient(Cel)   Call ClipAjout(Target.Value)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Range("D17:J17"), Target) Is Nothing Then
    Cancel = True
    Call ClipAjout(Target.Value)
  End If
End Sub 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Cel As Range
  If Not Intersect(Range("V22:AJ36"), Target) Is Nothing Then
    For Each Cel In Target
      Call ClipObtient(Cel)
    Next Cel
  End If
End Sub

Re,

Joco7915, il faudrait faire attention à ce que vous indiquez

Il n'y avait pas de bug dans ce que je vous ai donné ce sont seulement les plages indiquées initialement qui ne sont pas les bonnes

De plus, je ne devrais pas avoir à vous le rappeler

Merci d'y faire attention, sinon je vas devoir sévir

Ok je ferais gaffe à l'avenir Merci