Copie lignes non coloriées

[reve24]

Bonjour

Comment pourrais je copier les lignes de la feuil1 dont aucune cellule n est en couleur 4 ( VERT ) .
Reporter ces lignes A : E en feuille 2 .

merci d avance.

 

[phlaurent55]

Re : Copie lignes non coloriées

Bonjour Reve,

essaie ce code:

Sub Transfert()
Application.ScreenUpdating = False
Range("G2:L" & Range("G65535").End(xlUp).Row + 1).ClearFormats
Range("G2:L" & Range("G65535").End(xlUp).Row + 1).ClearContents
Dim cel As Range
For Each cel In Range("B2:B" & Range("B65535").End(xlUp).Row)
If cel.Interior.ColorIndex = 4 Then
Range(Cells(cel.Row, 1), Cells(cel.Row, 3)).Copy
Range("G" & Range("G65535").End(xlUp).Row + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next cel
[F2].Select
Application.ScreenUpdating = True
End Sub

à+
Philippe

 

[phlaurent55]

Re : Copie lignes non coloriées

Re,

voici le fichier

il te reste à adapter pour les colonnes D & E

à+
Philippe

 

[reve24]

Re : Copie lignes non coloriées

Avec toutes mes excuses mais je pense que je ne me suis pas bien exprimé
il ne s agit juste de copier que les ligne A2 A3 A4 dans cet exemple

 

[phlaurent55]

Re : Copie lignes non coloriées

Re,

Avec toutes mes excuses mais je pense que je ne me suis pas bien exprimé
il ne s agit juste de copier que les ligne A2 A3 A4 dans cet exemple

Dans ce cas, il faut modifier

If cel.Interior.ColorIndex <> 4 Then

au lieu de :
If cel.Interior.ColorIndex = 4 Then

à+
Philipps

 

[reve24]

Re : Copie lignes non coloriées

j ai reussi sous une forme
Sub SansCouleur()
Application.ScreenUpdating = False
Range("G2:L" & Range("G65535").End(xlUp).Row + 1).ClearFormats
Range("G2:L" & Range("G65535").End(xlUp).Row + 1).ClearContents
Dim cel As Range
For Each cel In Range("B2:B" & Range("B65535").End(xlUp).Row)
If cel.Interior.ColorIndex = -4142 Then
Range(Cells(cel.Row, 1), Cells(cel.Row, 5)).Copy
Range("G" & Range("G65535").End(xlUp).Row + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next cel
[F2].Select
Application.ScreenUpdating = True
End Sub

 

[phlaurent55]

Re : Copie lignes non coloriées

Re,

Pourquoi ceci: If cel.Interior.ColorIndex = -4142 Then

il s'agit de copier si la couleur de la cellule testée ( Interior.ColorIndex ) est est différente de 4

(voir réponse apportée au post précédent)

curiosité perso: il vient d'où de -4142

à+
Philippe

 

[Si...]

Re : Copie lignes non coloriées

salut Tous

attention Si... la macro est lancée d'une autre feuille. J'avais :

Sub copie()
  Dim L As Long
  With Sheets("Feuil1")
    For L = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
      If .Cells(L, 2).Interior.ColorIndex = xlNone Then
       .Cells(L, 1).Resize(1, 3).Copy .Cells(.Cells(Rows.Count, 7).End(xlUp).Row + 1, 7)
      End If
    Next
  End With
End Sub

@phlaurent55 : -4142 c'est Xlnone !
@reve24 : combien de colonnes faut-il copier ?

 

[reve24]

Re : Copie lignes non coloriées

curiosité perso: il vient d'où de -4142

Suivant macro
clic sur une cellule

Sub chercher_la_couleur()

Dim xx As Variant
xx = Selection.Interior.ColorIndex
MsgBox xx
End Sub

regarde le résultat et cela fonctionne ne me demande pas pourquoi -4142