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

  • Initiateur de la discussion Initiateur de la discussion Lapou
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

L

Lapou

Guest
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
 

Pièces jointes

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
 

Pièces jointes

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 à A3😀975.

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("A1😀1").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("A1😀1").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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Retour