Extraction de valeurs de cellules par code VBA

[rounil09]

Bonjour la liste,

Soit un tableau duquel on doit extraire le contenu de cellules en fonction du contenu d'autres cellules.
Voir en fichier joint exemple simplifié.
Je n'arrive pas à m'en sortir avec une boucle. J'utilise des Go to peu académiques…
Ayant plusieurs tableaux de ce type à traiter, quelqu'un peut-il me proposer un code fiable, mieux structuré ?

 

[Pierrot93]

Re : Extraction de valeurs de cellules par code VBA

Bonjour,

essaye peut être ceci, suppose A1 de la feuille TEST comporte un en-tête de colonne :

Option Explicit
Sub test()
Dim i As Long
With Sheets("Feuil1")
    For i = 6 To .Range("F65536").End(xlUp).Row
        If .Cells(i, 6) = "Non habilité" And .Cells(i, 3) = "HABILITE" Then _
            Sheets("TEST").Range("A65536").End(xlUp)(2) = .Cells(i, 2)
    Next i
End With
End Sub

bonne journée
@+

 

[rounil09]

Re : Extraction de valeurs de cellules par code VBA

Merci Pierrot.

 

[mécano41]

Re : Extraction de valeurs de cellules par code VBA

Bonjour à tous,

Sinon, pour le cas où il y aurait beaucoup de lignes :

Option Explicit
Option Base 1

Sub Extraction_CE_nx()
Dim T
Dim T1()
Dim PlageDonn As Range
Dim Cpt As Long
Dim Cpt2 As Long
With Worksheets(Feuil1.Name)
    Set PlageDonn = Range(.Range("B6"), .Range("F65535").End(xlUp))
End With
T = PlageDonn.Value
ReDim Preserve T1(1)
Cpt2 = 1
For Cpt = 1 To UBound(T)
    If T(Cpt, 5) <> "HABILITE" And T(Cpt, 5) <> T(Cpt, 2) Then
        T1(Cpt2) = T(Cpt, 1)
        ReDim Preserve T1(UBound(T1) + 1)
        Cpt2 = Cpt2 + 1
    End If
Next Cpt
        ReDim Preserve T1(UBound(T1) - 1)
Worksheets(Feuil2.Name).Range("A1").Resize(UBound(T1), 1).Value = WorksheetFunction.Transpose(T1)
End Sub

Edit : attention à l'écriture des "HABILITE" et "Non habilité" si ce n'est pas fait automatiquement (majuscules, espaces, accents...), sinon le code ne trouvera pas les bonnes lignes...

Cordialement