Fiche individuelle a partir d un tableau

Bonsoir tout le monde!

.-) je suis bloqué et je ne m'y connait que sommairement en VBA! je connais un peu les formules mais j'ai compris que les VBA étant entre les formules et les macros...bref...

J'ai du changer les noms et les rubriques car confidentielles.

J'ai lu un post de juillet (25?) résolu par U.Mility pour Gaelle et ses fiches pour ses plantes.

mais mon probleme est en colonne et non pas en ligne et certainement pour vous un truc de débutant.

Mon problème:

J'ai un tableau:

• a gauche les theorie et instructions.
• en haut nom,prenom,fonction
• en haut au desssus du nom un numéro.
• au croisement des noms et theories soit "p"(Présent) soit rien.

Ce que je voudrais:

double cliquer sur le numero au dessus du nom, que cela copie/colle dans l onglet fiche individuelle toutes les théories et qu au bout de chaque theorie il y ai le "P" ou rien.

De facon a avoir le recapitulatif des theories auxquelles la personne a participée.->fiche individuelle.

En version luxe les Noms prenoms fonction passeraient de vertical a horizontal...

Ce que vous devez peut etre aussi savoir...? Les donnees dans les colonnes ("noms,prenom","fonction","P") viennent d'un autre fichier excel(si cela influe ou pas je ne sais pas)

Je vous remercie tous deja d avance!

Pierre.

Bonjour Pierre,

à tester,

coller la macro sur la page code de l'onglet "texte1"

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim addrSource As String, addrDestination As String, fonction As String, nom As String
Set isect = Application.Intersect(Target, Range("H6:H" & Cells(6, Columns.Count).End(xlToLeft).Column))
If Not isect Is Nothing Then
    fonction = Cells(11, Target.Column)
    nom = Cells(10, Target.Column) & " " & Cells(7, Target.Column)

    addrSource = Range(Cells(18, Target.Column), Cells(46, Target.Column)).Address
    addrDestination = Range(Cells(18, "H"), Cells(46, "H")).Address

    Sheets("Fiche individuelle").Range(addrDestination).Value = Sheets("texte1").Range(addrSource).Value
    Sheets("Fiche individuelle").Range("D1").Value = fonction
    Sheets("Fiche individuelle").Range("D4").Value = nom
End If
End Sub

Bonsoir SabV,

Merci beaucoup pour votre précieuse aide sur mon problème!

feedback:

• Cela fonctionne seulement sur la première cellule ("1") H6
• Sur la feuille de GaelleO lorsqu'on clique sur la cellule cela ouvre directement l onglet.

Encore merci!

Bonne soirée,

Pierre.

Bonjour,

oups désolé, voici la modification,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim addrSource As String, addrDestination As String, fonction As String, nom As String
Set isect = Application.Intersect(Target, Range("H6:" & Cells(6, Columns.Count).End(xlToLeft).Address))
If Not isect Is Nothing Then
    fonction = Cells(11, Target.Column)
    nom = Cells(10, Target.Column) & " " & Cells(7, Target.Column)

    addrSource = Range(Cells(18, Target.Column), Cells(46, Target.Column)).Address
    addrDestination = Range(Cells(18, "H"), Cells(46, "H")).Address

    Sheets("Fiche individuelle").Range(addrDestination).Value = Sheets("texte1").Range(addrSource).Value
    Sheets("Fiche individuelle").Range("D1").Value = fonction
    Sheets("Fiche individuelle").Range("D4").Value = nom
End If
End Sub

Bonjour SabV,

Excellent! Merci beaucoup!

En vous souhaitant une agréable journée!

Cordialement,

Pierre.

Merci pour ce retour, au plaisir!

pour clôturer le fil, cliquer sur le bouton V vert du post à coté du bouton EDITER, merci!