copie cellule sous condition de couleur

[creolia]

Bonsoir a tous

je viens solliciter votre aide

j'ai fais une condition si la cellule valeur est inferieur a 10 il deviens rouge mais
maintenant je souhaiterais copier des cellules sous condition si ils sont à fond rouge copier la cellule dans la feuil 2 et si entre temps il redevienne dans ce blanc il s'enlève de la feuil 2

es ce possible svp

j'ai mis un fichier joins pour situer mon souhait merci de votre aide

 

[creolia]

Re : copie cellule sous condition de couleur

je relance mon appel car la je suis vraiment bloquer svp

 

[ROGER2327]

Re : copie cellule sous condition de couleur

Bonjour creolia

Pas sûr d'avoir tout compris... Voyez un essai dans le classeur joint.​

ROGER2327
#2579

 

[job75]

Re : copie cellule sous condition de couleur

Bonsoir creolia, Roger 🙂

Une solution par formule matricielle en Feuil2!A2 :

=SI(LIGNES(A$2:A2)>NB.SI(Feuil1!$D$2:$D$16;"<10");"";INDEX(Feuil1!A:A;PETITE.VALEUR(SI(Feuil1!$D$2:$D$16<10;LIGNE(INDIRECT("2:16")));LIGNES(A$2:A2))))

A valider par Ctrl+Maj+Entrée, et à tirer à droite et vers le bas.

Mettre la colonne C au format Date.

Bonne nuit.

 

[creolia]

Re : copie cellule sous condition de couleur

merci pour vos 2 réponse mais celle de ROGER2327 est mieux adapter a mon problème le seul soucis que d'essais de résoudre depuis ce matin c'est que j'arrive bien a copier la cellule nom prénom et date selon si le fond de la cellule soit rouge mais le soucis c'est quand elle est plus rouge elle s'enlève pas automatique dans le tableau de la feuil2 avez vous une idées svp

 

[creolia]

Re : copie cellule sous condition de couleur

je vais attendre ROGER2327 si il se connect ce soir car là je m'en sort pas lol

 

[job75]

Re : copie cellule sous condition de couleur

Bonjour creolia, salut Roger,

Vous préférez VBA, alors voici une autre solution.

La macro entre la formule matricielle dans les cellules, puis ne garde que leurs valeurs :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:D]) Is Nothing Then Exit Sub
Dim plage As Range, ad1$, ad2$, formule$, cel As Range
Set plage = Range("D1:D" & Range("A65536").End(xlUp).Row)
ad1 = "Feuil1!C"
ad2 = "Feuil1!" & plage.Address(ReferenceStyle:=xlR1C1)
formule = "=INDEX(" & ad1 & ",SMALL(IF(" & ad2 & "<10,ROW(" & ad2 & ")),ROWS(R2C:RC)))"
With Sheets("Feuil2")
  .Range("A2:C65536").ClearContents
  For Each cel In .Range("A2:C" & plage.Count)
    cel.FormulaArray = formule 'formule matricielle
    If IsError(cel) Then cel = "" Else cel = cel.Value
  Next
End With
End Sub

A+

 

[creolia]

Re : copie cellule sous condition de couleur

MERCI a toi JOB75 pour ta réponse j'ai crue un moment que sa fonctionnais pas vues que jetais partis sur si la cellule rouge copie dans feuil2 mais ce que tu ma proposer est baser directement sur la valeur ce qui résous mon problème


mais par curiosité es ce que ont peut se basé sur le changement de couleur d'une cellule c'est vraiment par curiosité vue je m'étais basé la dessus merci si tu répond et merci même si tu répond pas lol

🙂

 

[job75]

Re : copie cellule sous condition de couleur

Re,

En VBA il est possible de récupérer les couleur produites par une MFC mais c'est très compliqué et nécessite la construction de fonctions spéciales.

La meilleur solution est d'utiliser la ou les conditions de la MFC.

A+

 

[creolia]

Re : copie cellule sous condition de couleur

OUI je me doute mais j'avais trouver une solution de ce type sauf qu'il fallait que je relance le classeur pour pouvoir le mette a jour tu saurais si il existe une fonction pour initialiser tout un classeur pour simuler un redémarrage stp

 

[job75]

Re : copie cellule sous condition de couleur

Re,

(...) mais j'avais trouver une solution de ce type (...)

Ca m'étonne vraiment beaucoup, car encore une fois c'est compliqué, voir CE FIL.

Pour le reste pas compris ce que vous voulez.

A+

 

[creolia]

Re : copie cellule sous condition de couleur

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:D]) Is Nothing Then Exit Sub
Dim plage As Range, ad1$, ad2$, formule$, cel As Range
Set plage = Range("D1:D" & Range("A65536").End(xlUp).Row)
ad1 = "Feuil1!C"
ad2 = "Feuil1!" & plage.Address(ReferenceStyle:=xlR1C1)
formule = "=INDEX(" & ad1 & ",SMALL(IF(" & ad2 & "<10,ROW(" & ad2 & ")),ROWS(R2C:RC)))"
With Sheets("Feuil2")
  .Range("A2:C65536").ClearContents
  For Each cel In .Range("A2:C" & plage.Count)
    cel.FormulaArray = formule 'formule matricielle
    If IsError(cel) Then cel = "" Else cel = cel.Value
  Next
End With
End Sub

RE bonjour job75 je voulais savoir si il était possible avec le nom et prénom copier également la cellule valeur sans copier la cellule date merci pour ton aide

 

[job75]

Re : copie cellule sous condition de couleur

Bonjour creolia,

Pour copier la colonne "valeur" la solution est d'insérer une colonne C temporaire qui est ensuite supprimée :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:D]) Is Nothing Then Exit Sub
Dim plage As Range, ad1$, ad2$, formule$, cel As Range
Set plage = Range("D1:D" & Range("A65536").End(xlUp).Row)
ad1 = "Feuil1!C"
ad2 = "Feuil1!" & plage.Address(ReferenceStyle:=xlR1C1)
formule = "=INDEX(" & ad1 & ",SMALL(IF(" & ad2 & "<10,ROW(" & ad2 & ")),ROWS(R2C:RC)))"
With Sheets("Feuil2")
  .Range("A2:C65536").ClearContents
[COLOR="Red"]  .Columns(3).Insert 'insertion colonne C[/COLOR]
  For Each cel In .Range("A2:[COLOR="red"]D[/COLOR]" & plage.Count)
    cel.FormulaArray = formule 'formule matricielle
    If IsError(cel) Then cel = "" Else cel = cel.Value
  Next
[COLOR="red"]  .Columns(3).Delete 'suppression colonne C[/COLOR]
End With
End Sub

Edit : pour faire gagner du temps à la macro, on évite de remplir la colonne temporaire C avec ce code :

For Each cel In .Range("A2:B" & plage.Count & ",D2:D" & plage.Count)

Voir version (4).

A+

 

[creolia]

Re : copie cellule sous condition de couleur

merci pour ta réponse je vais tester cela

 

[creolia]

Re : copie cellule sous condition de couleur

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:C]) Is Nothing Then Exit Sub
Dim plage As Range, ad1$, ad2$, formule$, cel As Range
Set plage = Range("D1:D" & Range("A65536").End(xlUp).Row)
ad1 = "Feuil1!C"
ad2 = "Feuil1!" & plage.Address(ReferenceStyle:=xlR1C1)
formule = "=INDEX(" & ad1 & ",SMALL(IF(" & ad2 & "<10,ROW(" & ad2 & ")),ROWS(R2C:RC)))"
With Sheets("Feuil3")
  .Range("E2:G65536").ClearContents
  For Each cel In .Range("E2:G2" & plage.Count)
    cel.FormulaArray = formule 'formule matricielle
    If IsError(cel) Then cel = "" Else cel = cel.Value
  Next
End With
End Sub

bonjour je reviens vers vous pour un complément information pour essayer de comprendre le code je l'ai modifier pour au lieu qu'il copie dans la feuil2 et la colonne A2:C qu'il me le fasse dans la feuil3 dans la colonne F2:G mais rien ne se passe au mieux j'ai des zéro partout seriez vous pour quoi merci.