Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

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

  • Testlapou.zip
    2.7 KB · Affichages: 29
B

Bernard

Guest
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

  • TestlapouV1.zip
    14 KB · Affichages: 30
  • TestlapouV1.zip
    14 KB · Affichages: 32
  • TestlapouV1.zip
    14 KB · Affichages: 35
B

Bernard

Guest
Rebonjour Lapou

Quelques modifs pour simplifier le code.

Cordialement

Bernard
 

Pièces jointes

  • TestlapouV1.zip
    14.4 KB · Affichages: 54
  • TestlapouV1.zip
    14.4 KB · Affichages: 57
  • TestlapouV1.zip
    14.4 KB · Affichages: 56
L

Lapou

Guest
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…