Recherche selon critères, renvoi sur une autre feuille + suppression doublon...

[Lapou]

Bonjour tout le monde !!!

J'espère que vous allez bien ???
Moi ça peut aller ;-)

Je vous ais mis en fichier joint mon petit souci :
J'aimerais que sur une autre feuille, tout les noms de la plage E2:I7 (RECHERCHE) apparaisse sans doublons et que pour chacun de ces noms j'ai les docs qui le concerne. J'explique tt ds le fichier joint ;-)
Je ne sais pas si c'est faisable avec une formule ou pas mais si y'a pas d'autres solutions que le VBA je m'y collerais ;-)

En tout cas merci à tous pour vos futurs précieux conseils ;-)

Bonne journée à chacun d'entre vous
Tchao

 

[Lapou]

4h que je suis dessus et je ne trouve pas !!!

j'avais besoin de mettre un post ici pr me détendre ;-)

Tchaooooooooooooooooooooooooooo

 

[Bernard]

Bonjour Lapou et le forum

Je n'ai pas passé 4h mais il faut rester concentré sur le sujet.

A noter que dans l'exemple de résultat il manque une ligne dans Monique ! sinon j'ai rien compris ?

J'ai mis la mise à jour en automatique avec l'ouverture de la feuille "RECAP"

Cordialement

Bernard

 

[Bernard]

Rebonjour Lapou

Quelques modifs pour simplifier le code.

Cordialement

Bernard

 

[Lapou]

Bonjour Bernard, le Forum !!!

Merci Bernard je regarde ça de suite je n'ai pas eu accès avant ;-)

Bonne journéeeeeeeeeeeeeeeeee !!!!!!!!!!!!!

 

[Lapou]

Effectivemment il en manquait un chez monique ;-)

Donc si j'ai bien compris je récupère le code dans module et le tour est joué !

@+ tard ;-)

 

[Lapou]

Par contre je ne vois pas quel code changer dans "module" si ma plage des "noms" va de E3:X975 et les 4 colonnes correspondent à A3975.

Car y'a notamment en 6ème ligne "A2:E13" et je ne vois pas la correspondance !

Merci beaucoup à vous tous ;-)

Le code :
Option Explicit
Sub Transfertdonnées()
Dim MyPlage As Range
Dim C, Nom
Application.ScreenUpdating = False
Range("A2 :E13").ClearContents
Set MyPlage = Sheets("DONNEES").Range("E2:I7")
For Each C In MyPlage
' Boucle de mise en tableau des noms
If C <> "Non concerné" Then
'Noms absents + données
Set Nom = Range("A2:A1000").Find(What:=C)
If Nom Is Nothing Then
[B1000].End(xlUp).Offset(1, -1) = C 'Inscription du nom
C.EntireRow.Range("A11").Copy 'Inscription des données
[B1000].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Else
'noms présents + données
Nom.Offset(1, 0).EntireRow.Insert
C.EntireRow.Range("A11").Copy
Nom.Offset(1, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
'Elimination des doublons
If Nom.Offset(1, 1) = Nom.Offset(2, 1) And Nom.Offset(1, 2) = Nom.Offset(2, 2) And Nom.Offset(1, 3) = Nom.Offset(2, 3) And Nom.Offset(1, 4) = Nom.Offset(2, 4) Then
Nom.Offset(1, 1).EntireRow.Delete
End If
End If
End If
Next C
Range("A1").Activate
Application.ScreenUpdating = True
End Sub

Bonne journée
Tchao

 

[Lapou]

Re tout le monde !!!

C'est bon pour les critères que je recherchais, suffisais que je réfléchisse un peu ;-)

Bonne journée !
Tchao