Macro pour copier coller données

[aure_8]

Bonsoir le forum,

Je viens vers vous parce que j'ai un problème avec une de mes macros. Celle-ci est censée copier-coller des données d'une feuille vers l'autre lorsque je double clic sur une cellule:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Dc As Integer, Nf As String, i As Integer, x As Integer
Dim Dl As Range, Nom As String
Dim Ligne As Long

x = 0
If Target.Column = 2 And Target.Row > 1 Then
  Cancel = True
  For i = Target.Row To 1 Step -1
    If Target.Offset(x, -1) = "" Then
      x = x - 1
    Else
      Nf = Right(Target.Offset(x, -1), 1)
      Nom = Target.Offset(x, -1).Value
      Exit For
    End If
  Next i
  With Sheets("Feuil1")
    Ligne = .Range("C" & Rows.Count).End(xlUp).Row + 1
    .Range("C" & Ligne) = Nom
    .Range("E" & Ligne) = Target.Offset(0, 2)
    'Set Dl = .Range("C18:C29")
   'Dl = Nom
   'Dl(1, 3) = Target(1, 3).Value
 End With
End If
End Sub

Le problème c'est que je voudrais définir une zone de copie qui soit figée (C18:C29), mais ma ligne de code pose problème:

Ligne = .Range("C" & Rows.Count).End(xlUp).Row + 1

Je n'arrive pas à l'adapter.

Merci à vous ! (je mets un exemple en PJ)
Cdlt
aure_8

 

[Jack2]

Re : Macro pour copier coller données

Bonsoir,

Il n'y a pas d'exemple en feuille2. Est-ce que tu pourrais expliquer un peu plus où tu veux arriver et donner plus d'exemples SVP. Y a-t-il plus de 12 dates par noms...

A+ Jack2

 

[aure_8]

Re : Macro pour copier coller données

Bonjour!

En Fait il y'a 6 dates pour un seul nom, si je diuble clique sur D1 du bloc name1, alors name1 et la date en face de D1 se copient en feuille1, et ainsi dessuite pour chaque bouble clic. Rien ne se cooie en feuille 2 ou 3.

merci de ton attention
cdlt
aure_8

 

[job75]

Re : Macro pour copier coller données

Bonjour aure_8, salut Jack2,

Dans la mesure où les cellules sont fusionnées en colonne A c'est très simple :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [B2:B65536]) Is Nothing Then Exit Sub
Cancel = True
With Sheets("Feuil1").[C65536].End(xlUp)(2)
  .Value = Target(1, 0).MergeArea(1)
  .Cells(1, 3) = Target(1, 3)
End With
End Sub

Je n'ai pas compris ce que vient faire Feuil2 là-dedans.

S'il vous faut autre chose dites-le.

Fichier joint.

A+

 

[job75]

Re : Macro pour copier coller données

Re,

Si l'on veut éviter les doublons en Feuil1 on peut utiliser :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [B2:B65536]) Is Nothing Then Exit Sub
Dim nom, dat, c As Range
Cancel = True
nom = Target(1, 0).MergeArea(1)
dat = Target(1, 3)
With Sheets("Feuil1").[C65536].End(xlUp)(2)
  'If .Row > 29 Then MsgBox "Zone pleine !": Exit Sub 'facultatif
  For Each c In .Parent.Range(.Cells, .Cells(19 - .Row))
    If c = nom And c(1, 3) = dat Then Exit Sub 'évite les doublons
  Next
  .Resize(, 2).Merge 'fusion
  .Cells(1, 3).Resize(, 2).Merge 'fusion
  .Resize(, 4).Borders.Weight = xlThin 'bordures
  .Value = nom
  .Cells(1, 3) = dat
End With
End Sub

A chaque fois il y a mise en forme (fusions, bordures) des cellules en Feuil1.

Fichier (2).

A+

 

[aure_8]

Re : Macro pour copier coller données

Re,

Un grand merci pour ton aide !
Je n'avais pas pensé à éviter les doublons mais c'est vrai que c'est utile!

Encore merci et bon week !

Cdlt
aure_8

 

[job75]

Re : Macro pour copier coller données

Bonjour aure_8, le forum,

Un tri du tableau en Feuil1 est sans doute souhaitable.

Si ce tableau devient très grand la recherche des doublons en sera beaucoup accélérée :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [B2:B65536]) Is Nothing Then Exit Sub
Dim nom, dat, P As Range, i
Cancel = True
nom = Target(1, 0).MergeArea(1)
dat = Target(1, 3)
With Sheets("Feuil1").[C65536].End(xlUp)(2)
  'If .Row > 29 Then MsgBox "Zone pleine !": Exit Sub 'facultatif
  Set P = .Parent.Range(.Cells, .Cells(19 - .Row))
  i = Application.Match(nom, P, 0)
  If IsError(i) Then i = P.Count
  For i = i To P.Count 'recherche des doublons
    If P(i) <> nom Then Exit For
    If P(i, 3) = dat Then Exit Sub
  Next
  .Resize(, 2).Merge 'fusion
  .Cells(1, 3).Resize(, 2).Merge 'fusion
  .Resize(, 4).Borders.Weight = xlThin 'bordures
  .Value = nom
  .Cells(1, 3) = dat
  P.Resize(, 4).Sort P(1), , P(1, 3), Header:=xlNo 'tri
End With
End Sub

Edit : dans la boucle i les tests doivent être dans le bon ordre.

Fichier (3).

A+

 

[aure_8]

Re : Macro pour copier coller données

Bonsoir le forum;

C'est effectivement un très bonne idée du fait que la taille du fichier va pas mal augmenter, je pourrais ainsi éviter de me retrouver avec des erreurs.
Merci pour votre aide et @+

Cdlt
aure_8