Besoin aide macro excel créer un tableau

Résolu
caribou38 Messages postés 31 Statut Membre -  
caribou38 Messages postés 31 Statut Membre -
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
Configuration: Windows XP
Firefox 3.0

1 réponse

  1.
    gbinforme Messages postés 14930 Date d'inscription   Statut Contributeur Dernière intervention   4 744
     
    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
    1. caribou38 Messages postés 31 Statut Membre
       
      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