Copier coller par double clic

[CLAUDE19]

Bonjour à tous,

Je reviens vers vous pour un 2nd problème.
J'ai besoin dans un fichier excel 2007 de copier coller en se placant sur une cellule d'une ligne de l'onglet 1 en faisant un double clic de coller cette ligne vers le même tableau dans l'onglet 2.
En répétant le double clic copier les lignes de l'onglet 1 sous la dernière ligne copiée de l'onglet 2.
Voir fichier joint
D'avance merci pour votre aide

Cordialement

 

[CLAUDE19]

Re : Copier coller par double clic

Pour le + 7 j'avais déjà modifié, pour ce qui est du copié collé cela ne fonctionne pas car si on change de feuille le dernier double clic écrase la dernière ligne copiée.
Je comprend tout à fait ces deux fichiers sont un peu lourds en effet.

Merci quand même

 

[CLAUDE19]

Re : Copier coller par double clic

J'avais modifié le +7 et ca fonctionne effectivement, quand au copié collé sur les autres feuilles même en changeant le nom ça ne convient pas car la ligne ne vient pas se rajouter à la dernière mais prend sa place en se collant dessus. En fait ce que je tente de faire c'est de reprendre des macros d'une macro complémentaire dans excel 2003 qui n'est plus utilisable dans 2007. Le code de la commande était celui ci-dessous
_______________________________________
ublic Sub DoubleClic()

nom_du_fichier_double_clic = ActiveWorkbook.Name
nom_de_la_feuille_double_clic = ActiveSheet.Name
If ((nom_du_fichier_travail = nom_du_fichier_double_clic) _
And (nom_de_la_feuille_double_clic <> "Fiche prépa")) Then

numero_ligne = ActiveCell.Row
numero_colonne = ActiveCell.Column
If Cells(numero_ligne, 7) = Empty Then Exit Sub
If numero_ligne > 8 Then
Selection.EntireRow.Select
Selection.Font.ColorIndex = 49
Selection.Copy
NomFeuille = ActiveSheet.Index

On Error GoTo Affichage_message_erreur_3
Sheets("Fiche prépa").Select
On Error GoTo 0

i = Range("description").Row
j = Range("description").Column
Do
i = i + 1
Loop Until Sheets("Fiche prépa").Cells(i, j) = Empty
Cells(i, 1).EntireRow.Select
ActiveSheet.Paste
Selection.Font.ColorIndex = xlAutomatic
Sheets(NomFeuille).Select
Cells(numero_ligne, numero_colonne).Select
End If
End If
Exit Sub

Affichage_message_erreur_3:
Msg = "La fiche de préparation 'Fiche prépa' n'existe pas sur ce fichier."
Style = vbOKOnly + vbExclamation ' Définit les boutons.
Title = "Erreur mineure" ' Définit les titres.
' Affiche le message.
Réponse = MsgBox(Msg, Style, Title)
Exit Sub
Resume

End Sub
_________________________________________________

Voilà, mais je comprend tout à fait que tu n'es pas le temps de passer des lustres sur ce problème. Je te remercie de m'avoir apporter ton aide
Cordialement

 

[stefan373]

Re.

Faite un petit fichier test avec le code qui ne va pas et là on pourra vous aider.

A +

 

[LE MATIN]

Re : Copier coller par double clic

bonsoir à tous,

je me permets de venir participer à cette discusion, pour une petite précision

comment modifier le code du fichier de Philippe (post#4) pour pouvoir copier coller en une seule fois plusieurs lignes continues ou discontinues
merci par avance de vos réponses.

 

[CLAUDE19]

Re : Copier coller par double clic

Bonjour,

Je reviens vers vous pour vous dire que j'ai trouvé la solution.
Quand je dis "j'ai" j'avoue que le forum "VBA excel" de développez.com m'a bien aidé. Ci-dessous les lignes qui répondent à ma demande.
Je remercie encore une fois toutes les personnes qui ont bien voulues m' accorder de leur temps sur ce problème.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim NewLig As Long
If Sh.Name <> "Fiche prépa" Then
Application.ScreenUpdating = False
Cancel = True
If Not Intersect(Target.EntireRow, Sh.UsedRange) Is Nothing Then
With Sheets("Fiche prépa")

NewLig = .Range("A6").CurrentRegion.Rows.Count + .Range("A6").CurrentRegion.Row
If NewLig < 7 Then NewLig = 7 ' Premiére ligne en 7
End With
With Intersect(Target.EntireRow, Sh.UsedRange)
.Copy Sheets("Fiche prépa").Range("A" & NewLig)
.Font.Color = -11489280
End With
MsgBox "L'exposition du risque a bien été saisie"
End If
End If
End Sub


Cordialement à vous

 

[Staple1600]

Re : Copier coller par double clic

Bonsoir

C'est au début de ton fil que tu aurais du dire que tu es adepte du crossposting...

Il est d'usage de prévenir quand on pose une question sur plusieurs forums.


Ps: décidément c'est une épidémie

 

[Byzoux]

Re : Copier coller par double clic

Bonjour à vous

Cette fonction est éxactement ce que je cherchait, par contre , je ne comprends pas bien comment la modifier pour qu'elle copie la ligne cliquée soit :

- toujours au même endroit (à savoir sous l'entête), pour écraser l'ancien résultat (dans le but de récupérer cette sélection dans un formulaire qui lis toujours dans cette première ligne
- soit faire idem, mais en insérant une ligne sous l'entête à chaque nouvel enregistrement (c'est important pour moi, puisque la première colonne de l'entête comporte un lien hypertexte qui se recopie automatiquement gâce à l'insersion de ligne)

Bien à vous

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row = 1 Then Exit Sub
Application.ScreenUpdating = False
ligne = Target.Row
Rows(ligne).Select
With Selection.Font
.Color = -11489280
.TintAndShade = 0
End With
Selection.Copy
Sheets(1).Select
pos = Sheets(1).Range("A500").End(xlUp).Row + 1
Sheets(1).Cells(pos, 1).Select
ActiveSheet.Paste
' la ligne ci-dessous evite la couleur verte dans l'onglet 1
With Selection.Font
.Color = 0
.TintAndShade = 0
End With
Application.CutCopyMode = False
Sheets(1).[A1].Select
Sheets(2).Select
[A1].Select
Application.ScreenUpdating = True
MsgBox ("Le transfert de la ligne a été fait")
End Sub

 

[Byzoux]

Re : Copier coller par double clic

En fait, je m'apperçois qu'il faut insérer cette macro dans la feuille elle même et pas dans un module et lancer la focntion Worksheet_BeforeDoubleClick etc avant

je ne parviens pas à faire fonctionner pour l'instant, mais ça ne change pas ma question au sujet de cette macro commande.

J'ai placé le code complet ci dessus, voilà mes conclusions


Selection.Copy
Sheets(1).Select


'Cette prochaine partie initialise la variable "pos" à la dernière ligne "occupée" et
'incrémente de 1 pour copier une ligne plus bas'

si je souhaite copier toujours à la même ligne (pour écraser le résultat précédent) je supprime ou place cette ligne en commentaire'

'pos = Sheets(1).Range("A500").End(xlUp).Row + 1
'Sheets(1).Cells(pos, 1).Select'

'j'indique ensuite une cellule, puis sélectionne la ligne pour copier comme suit'

Sheets(1).[A2].Select
Sheets(1).Rows(ActiveCell.Row).Select

ActiveSheet.Paste

Pour remplir un tableau par le haut, j'insère une ligne avant de copier (ce qui recopie le format de l'entête à chaque fois).

Désolé de faire les questions et les réponses ... il y a peut-être plus élégant au niveau code ?

J'ai une petite question subsidiaire, lié à ce code. Peut-on rendre clicable le résultat d'une recherche qui sort à l'intérieure d'une fenêtre de formulaire ?