Besoin aide macro excel créer un tableau

Résolu
caribou38 Messages postés 30 Date d'inscription   Statut Membre Dernière intervention   -  
caribou38 Messages postés 30 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

je dois créer un tableau a partir de données récupérées sur une feuilles liste
la macro doit aller chercher toutes les numéros identiques dans la liste copier la référence et la mettre dans le tableau feuil1
je joint un exemple car je suis conscient que mes explications ne sont pas trés claires

merci de votre aide

https://www.cjoint.com/?iwveOoB1o2
A voir également:

1 réponse

Réponse 1 / 1
gbinforme Messages postés 14946 Date d'inscription   Statut Contributeur Dernière intervention   4 724
 
bonjour

Si j'ai compris ton exemple tu n'as pas besoin de macro, avec cette formule cela fonctionne : 
=RECHERCHEV(A2;liste!$A$1:$Q$7;17;0)

Sinon c'est peut-être ton exemple qui est trop succinct.
0
caribou38 Messages postés 30 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour

merci de t'intéresser a mon cas je suis bloqué dans mon projet et je tourne en rond sans trouver de solution
la formule que tu m'as donnée aurait fonctionné si mon tableau était fixe mais il varie il peut aller jusqu'a 2000 lignes

mes explications étaient succincts en fait la macro doit rechercher dans la liste tous les numéro identique et les mettre dans un tableau récapitulatif avec a la fin la référence

par exemple

314 234RTZ 345ZDE 655DSZ
315 345ZDE 456TJK 456UGF
j'essaie de modifier cette macro mais pour l'instant sans succés je parvient jusque a recopier en boucle la référence

Col = "AJ" ' colonne données non vides à tester'
NumLig = 2 ' N° de la 1er ligne de données
With Sheets("Liste moteur") ' feuille source'
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 2 To NbrLig 'n° de la 1ere ligne de données'
If .Cells(Lig, Col).Value <> "" Then

Range("G3:AH2000").Find(What:=Sheets("feuille de saisie").Range("F6").Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

num = ActiveCell.Row
Cells(num, Col).Copy

Sheets("Feuil1").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

NumLig = NumLig + 1

End If
Next Lig
End With
End Sub
0