Copier les valeures grisées 50%

[isa44]

Bonjour le forum ,

Je joint un classeur où je voudrais copier les valeures grisées à 50% de la feuille A dans la feuille B sur une colonne en tri croissant.

Je vous remercie par avance pour votre aide

 

[CBernardT]

Re : Copier les valeures grisées 50%

Bonjour isa44,

Le fichier n'est pas passé, peut-être trop lourd ?? 50Ko maxi sinon le compresser avec WINZIP.

 

[isa44]

Re : Copier les valeures grisées 50%

Le voici allégé

 

[Robert]

Re : Copier les valeures grisées 50%

Bonjour Isa, Bernard, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim cel As Range 'déclare la variable cel (CELlule)
Dim dest As Range 'déclare la variable dest (DESTination)
Dim pl As Range 'déclare la variable pl
Set pl = Sheets("B").Range("B6:B" & Sheets("B").Range("B65536").End(xlUp).Row)
If Sheets("B").Range("B6") <> "" Then 'condition : si il y a des données, efface les anciennes données
    pl.ClearContents
End If 'fin de la condition
For Each cel In Sheets("A").UsedRange 'boucle sur toutes les cellules editées dans l'onglet A
    If cel.Font.ColorIndex = 16 Then 'condition : si la cellule est à 50% de gris
        Set dest = Sheets("B").Range("B65536").End(xlUp).Offset(1, 0) ' définit la cellule de destination
        dest.Value = cel.Value 'récupère la valeur de la cellule cel dans dest
    End If 'fin de la condition
Next cel 'prochaine cellule de la boucle
Set pl = Sheets("B").Range("B6:B" & Sheets("B").Range("B65536").End(xlUp).Row) 'redéfinit la plage pl
'trie la plage pl
pl.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End Sub