Copier des valeurs de cellules selon une condition

Question

Je me permets de poser cette question ici car je n'arrive pas à trouver de solution. J'ai épluché pas mal de sujet sur le forum ou sur d'autres mais malheureusement, toutes mes tentatives ont échouées. Bref, voilà ma demande : J'ai un tableau excel qui est un tableau de saisi de numéros, ces numéros renvoient tout un tas de valeurs utiles mais stockées sous la forme de formules dans ce tableau car elles renvoient à d'autres onglets du classeur excel. Je souhaiterais maintenant utiliser une partie de ces champs pour rapatrier leurs valeurs afin de créer un nouveau tableau, sur un nouvelle feuille, rapatriant un lot de ces données selon une condition définie dans la colonne "N", à savoir "RETIRE", sauf que cette condition est elle aussi, non pas une valeur stockée dans le tableau mais est une formule de ce type : =SI(RECHERCHEV(A4;'Fiche produit'!A:I;7;FAUX)=0;"";RECHERCHEV(A4;'Fiche produit'!A:I;7;FAUX)) Ainsi, ce que je souhaiterais, c'est créer une Macro, que j'associerais à un bouton (qui l'exécuterais) et rapatrierais les valeurs de la colonne A, M, N, P et R, et ce dans une nouvelle feuille de calcul "RI" créée lors de l'exécution du bouton. Je souhaiterais évidemment que ces valeurs soient rangées les unes après les autres... Voilà, j'espère que ma demande est assez claire. Je ne peux pas vous mettre le tableau en PJ. Il contient un grand nombre de base, il est donc très lourd, 10MO.je vous mets une capture d'écran que vous puissiez voir à quoi ça ressemble... Merci d'avance pour l'aide que vous pourrez m'apporter...

curulis57 · Accepted Answer

A l'aveugle... À toi à créer le bouton et à coller le code ! Dim tTab, tExtract(), iIdx%, iCol% ' Application.ScreenUpdating = False tTab = Range("A2:R" & Range("A" & Rows.Count).End(xlUp).Row).Value ' For x = 2 To UBound(tTab, 1) If tTab(x, 14) = "RETIRE" Then iIdx = iIdx + IIf(x &gt; 2, 1, 2) ReDim Preserve tExtract(5, iIdx) For y = 0 To 4 iCol = Choose(y + 1, 1, 13, 14, 16, 18) If x = 2 Then tExtract(y, 0) = tTab(1, iCol) tExtract(y, iIdx - 1) = tTab(x, iCol) Next End If Next ' On Error Resume Next If Worksheets("RI") Is Nothing Then Worksheets.Add(after:=Sheets(Sheets.Count)).Name = "RI" On Error GoTo 0 ' With Worksheets("RI") .Cells.Delete .Range("A1").Resize(iIdx, 5).Value = WorksheetFunction.Transpose(tExtract) .Activate End With Application.ScreenUpdating = True A+...