VBA collage de données en fonction d'une cellule

Bonjour tout le monde,

Après de nombreux essais et de nombreuses heures passées sur les forums pour trouver une solution, je désespère...

Je souhaite créer une macro qui puisse recopier certaines données de la feuille1 vers la feuille2, en fonction du contenu d'une cellule elle même présente dans la feuille 1.

Dans mon exemple ci-joint, en feuille 1 on retrouve le nom, prénom et adresse du client ainsi que 3 numéros de contrats qui lui sont attribué car cette personne souscrit à 3 services différents (d'où 3 numéros différents).

Dans la feuille 2, est répertorié l'ensemble des contrats signés, classés par type de service.

Ce que je souhaiterai donc c'est que si dans ma feuille 1 j'ai 3 contrats pour la même personne (donc 3 numéros de contrats):

• P/15/01
• Q/15/01
• R/15/01

Ce qui se traduirait par analyser le numéro du contrat présent en D5 de la feuille 1, puis rechercher la plage correspondant au début du numéro de contrat dans la feuille 2 (ici pour D5 on aurait à rechercher la plage où on a "P/15/" dans la feuille 2), et une fois la plage trouvée, écrire dans la première cellule vide de la colonne D de cette plage, le nom, prénom et adresse.

Même opération pour les contrats 2 et 3 qui iront donc s'inscrire dans leurs plages respectives dans la feuille 2.

Voilà, j'ai essayé de faire le plus clair possible... J'espère qu'une bonne âme charitable pourra m'aider car cela dépasse mes compétences en macro, je suis totalement bloqué...

Je remercie d'avance ceux qui prendront le temps de m'aider !

Cordialement,

Corsaiire.

Bonjour Corsaiire, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim O1 As Object 'déclare la variable O1 (Onglet 1)
Dim O2 As Object 'déclare la variable O2 (Onglet 2)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim R As Range 'déclare la variable R (Recherche)

Set O1 = Sheets("Feuil1") 'définit l'onglet O1
Set O2 = Sheets("Feuil2") 'définit l'onglet O2
For Each CEL In O1.Range("D5:D7") 'boucle sur toutes les cellules CEL de la plage D5:D7
    If CEL <> "" Then 'condition 1 : si la cellule n'est pas vide
        'définit la recherche R (recherche exacte des 5 premiers caractères de la cellule CEL)
        Set R = O2.Cells.Find(Left(CEL.Value, 5), , xlValues, xlWhole)
        If Not R Is Nothing Then 'condition 2 : si il existe au moins une occurrence trouvée
            R.Offset(0, 2).Value = O1.Range("D2").Value 'renvoie le nom dans la cellule de l'occurrence trouvée décalée de deux colonnes à droite
            R.Offset(0, 3).Value = O1.Range("D3").Value 'renvoie le prénom dans la cellule de l'occurrence trouvée décalée de trois colonnes à droite
            R.Offset(0, 4).Value = O1.Range("D4").Value 'renvoie l'adresse dans la cellule de l'occurrence trouvée décalée de quatre colonnes à droite
        End If 'fin de la condition 2
        Set R = Nothing 'vide la variable R
    End If 'fin de la condition 1
Next CEL 'prochaine cellule de la boucle
End Sub

Bonsoir ThauThème,

Que dire hormis MERCI ? C'est juste parfait, et très bien détaillé !

C'est exactement ce qu'il me fallait, à une chose près, c'est que j'aimerai que la macro enregistre donc ce que tu as crée, mais les lignes les unes en dessous des autres. C'est à dire que si j'exécute la macro une deuxième fois, elle me réécrive la ligne en dessous de la première qu'elle à écrite lors de la première activation.

Tout simplement car il y aura plusieurs clients qui souscriront au service 1 comme pour le 2 et le 3.

Je crois qu'il faut utiliser la fonction "derlig" pour signifier à la macro d'écrire sur la dernière ligne (ou première ligne vide comme on veut), mais je suis incapable de l'insérer comme il faut dans ta macro...

Bonne soirée à toi

Bonsoir Corsaiire, bonsoir le forum,

Tels que tu le présentes dans ton exemple tu n'acceptes que 3 fois la macro au maximum. En mettant tes tableaux en Feuil2 les uns en dessous des autres ça complique considérablement les choses. Ton exemple ne correspond pas à ce que tu voudrais ou c'est moi qui comprends pas... Explique-moi mieux et je verrai si je trouve une solution.

Bonjour Thau Thème,

En effet tel que je l'ai présenté on peut utiliser la macro que 3 fois au maximum. Mais c'est un exemple comme ça pourrait être 10 ou 20. J'ai pris 3 pour simplifier les choses.

L'idée est donc de faire ce que tu as déjà remarquablement fait, mais de pouvoir enregistrer les lignes de données les unes en dessous des autres, et non en écrasant la précédente. Actuellement, si on exécute ta macro une première fois, c'est impeccable elle écrit ce qu'il faut dans les différents tableaux de la feuille 2. Si on l'exécute une deuxième fois, elle marche toujours mais elle va écrire les données à la place de ce qu'elle à déjà écrit avant. Or je voudrais qu'elle écrive systématiquement sur la ligne du dessous, c'est à dire sur la première ligne vide du tableau où elle doit s'insérer.

Concrètement, imaginons que le client 1 qui porte le nom PIERRE Paul, souscrit à 2 services (service 1 et service 2), il a donc 2 numéros de contrats. J'exécute la macro, elle remplie dans les 2 tableaux (celui du service 1 et du service 2) son nom, son prénom et son adresse.

Maintenant il y a un deuxième client (client 2) qui porte le nom ALBERT Alexandre et lui il souscrit à 3 services (service 1,2 et 3), il a donc 3 numéros de contrats. J'exécute la macro, elle remplie dans les 3 tableaux (celui du service 1, 2 et 3) son nom, prénom et adresse.

On devra donc se retrouver avec 2 lignes remplies dans le tableau du service 1, pareil pour le service 2, et dans le tableau du service 3, la première ligne remplie avec les données du client ALBERT car il est le seul à avoir souscrit à ce service.

Je souhaiterai donc voir apparaître les lignes de données dans le tableau pour chaque clients, de façon à pouvoir voir combien de contrats j'ai signé pour tel ou tel service, ou encore pouvoir savoir à qui est attribué tel ou tel numéro de contrat, d'où l'utilité de ne pas effacer les lignes que la macro à préalablement écrite. (Pour les numéros de contrats, je m'en occuperai, on oubli pour le moment).

A l'heure actuelle j'ai une macro qui permet d'écrire sur la dernière ligne d'un tableau, mais on ne parle ici que d'un tableau, alors que nous on en à plusieurs ... Je te met le code quand même si ça peut t'inspirer ...

Set ws = Worksheets("feuil1")
    Set ws1 = Worksheets("feuil2")
    derlig = ws1.[D65536].End(xlUp).Row + 1
    ws.[X7:X16].Copy
    ws1.Range("D" & derlig).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    ws1.Activate

J'espère que j'ai été plus clair cette fois-ci, merci encore pour ton aide car seul j'y arrive pas là...

Bonjour Corsaiire, bonjour le forum,

Certes tu a rajouté deux lignes mais cela limite toujours le nombre de fois où la macro pourra être exécutée. L'idéal serait d'avoir les tableaux non pas les uns en dessous des autres mais cote à cote. Seulement je ne sais pas si ça te conviendrait...

Re-bonjour,

Le soucis de les mettre les uns à coté des autres c'est que je trouve le visuel beaucoup moins pratique qu'en ligne...

De plus je sais que par service, je n'aurai pas plus de 20 contrats dans l'année, donc que la macro puisse être limitée dans le nombre de fois où on l'exécute, c'est pas un soucis pour moi.

A+

Corsaire

Bonjour Corsaiire, bonjour le forum,

Ok on va partir sur 20 lignes Max. Je t'envoie ça dès que j'ai fini...

Bonjour Corsaiire, bonjour le forum,

pas le temps de commenter les codes modifiées...

Que de rapidité... Merci beaucoup ThauThème !

Fallait être patient pour comprendre, je t'en remercie.

Passe de bonnes fêtes de fin d'année.

A+

Corsaiire