Microsoft 365 Vba : copier certaines cellules suivant la valeur d'une autre

[flo59114]

Bonjour à tous,

Je viens vous concernant une extraction de données sur Excel.

Sur une plage sélectionnée, je voudrais qu'à chaque fois qu'une cellule est égale à 10, ça me copie le nom, le paramètre et l'unité sur une autre feuille.

J'ai mis un fichier exemple avec en feuil2 ce que je voudrais comme résultat.

J'ai fait toute ma macro et je sèche sur ce point là.

Vous remerciant par avance pour votre aide.

 

[vgendron]

Bonjour

tu parles d'une macro.. elle est où?

voir PJ

 

[mapomme]

Bonsoir à tous🙂,

Une macro qui devrait fonctionner. Le code de la macro est dans module1.
errata : la version v1 listait les valeurs au lieu des noms. La v2 corrige cette bourde.

Sub Lister()
Dim t, der As Long, i As Long, j As Long, n As Long
   With Sheets("Feuil1").UsedRange                       ' avec la plage utile de la feuille Feuil1
      t = .Range("a1").Resize(.Row + .Rows.Count, .Column + .Columns.Count)   ' lecture des valeurs
   End With
 
   For der = 3 To UBound(t, 2)         ' recherche de la première colonne vide après les noms de la ligne 4
      If t(4, der) = "" Then Exit For  ' une cellule vide a été détectée => on quitte la boucle
   Next der
   der = der - 1                                ' la dernière colonne des noms
   ReDim v(1 To UBound(t) * (der - 2), 1 To 3)  ' le tableau r contenant les valeurs résultats

   For i = 7 To UBound(t)           ' boucle sur les lignes de t à partir de la ligne 7
      If Trim(t(i, 1)) <> "" Then   ' si le paramètre n'est pas vide alors
         For j = 3 To der           ' on boucle sur les colonnes des noms
            ' si la valeur de la colonne n'est pas vide, on ajoute la valeur dans le tableau résultat
            If Trim(t(i, j)) <> "" Then n = n + 1: v(n, 1) = t(i, 1): v(n, 2) = t(i, 2): v(n, 3) = t(4, j)
         Next j
      End If
   Next i
 
   With Sheets("Feuil2")                                       ' affichage sur la feuille "Feuil2"
      .Range(.Cells(4, "a"), .Cells(.Rows.Count, "c")).Clear   ' effacement des précédent résultats
      If n > 0 Then .Cells(4, "a").Resize(n, 3) = v            ' si v comporte au moins une ligne, on l'affiche
      .Select                                                  ' sélection de la feuille "Feuil2"
   End With
End Sub