Macro lister selon couleur écriture

[Luinil]

Bonjour bonjour.

J'ai dans la colonne D, des noms.
J'ai dans la colonne G, un chiffre qui représente une distance.

J'utilise une Mise en Force conditionnel pour que le chiffre en colonne G deviennent écrit en rouge si celui ci est plus petit que 30.

J'ai besoin de votre aide pour trouver une macro qui me permetterais de lister en B8 et plus, les nom (colonne D) de tous ceux qui sont a 30 et moins de distance (soit par calcul, soit par couleur).

Il y a un AS capable de m'aider ?

Merci milles fois d'avance.
Luinil

 

[Staple1600]

Re : Macro lister selon couleur écriture

Bonsoir

En utilisant le filtre automatique

Sub Macro1()
Application.ScreenUpdating = False
With Worksheets(1)
    With .Range("D1:G1")
        .AutoFilter
        .AutoFilter Field:=4, Criteria1:="<=30", Operator:=xlAnd
        .CurrentRegion.Copy Worksheets(2).[A1]
    End With
.AutoFilterMode = False
Worksheets(2).[A1].CurrentRegion.Cut .[B8]
End With
Application.ScreenUpdating = True
End Sub

 

[soenda]

Re : Macro lister selon couleur écriture

Bonsoir le fil, Stapple1600, Luinil

En l'absence d'un classeur exemple, il est dificile de proposer une solution adaptée au contexte.
Voici une autre proposition (avec l'enregistreur de macro):

    Application.ScreenUpdating = False
 
    [A1].FormulaR1C1 = "=IF(SMALL(C[6],ROW())<30,SMALL(C[6],ROW()),"""")"
 
    With Range("A1:A" & [G65536].End(xlUp).Row)
        [A1].AutoFill .Offset
        .Value = .Value
    End With

A plus

 

[Luinil]

Re : Macro lister selon couleur écriture

N'étant que débutant et ne comprenant pas tout de votre code ^^

Je poste ici l'exemple en espérant que vous pourrez y jettez un coup d'oeuil

Merci énormément pour le temps que vous consacrez a mon problème!

Luinil.

http://cjoint.com/?lheQZ7gYDm

Edit:
En suivant vos conseils, j'ai combiner l'enregistreur de macro et le filtre pour arriver a mes fin!

Sa marche bien, mais il y a surement façon d'épurer un peu se code ^^

Sub Triez()
'
' Triez Macro
' Macro enregistrée le 2009-11-06 par Franck
'

    Columns("G:G").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="<=30", Operator:=xlAnd
    Range("G3:G1000").Select
    Selection.Copy
    Range("C21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D3:D1000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("G:G").Select
    Selection.AutoFilter Field:=1
    Range("B8:C1198").Select
    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

    Range("B8").Select
End Sub