Vba Excel : Importer Cellule colorer Feuille

Andreaa -  
eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,

Voila je possede de feuille Feuille 1 et Feuille 2.
J'aimerai en fait que ma macro me colle sur la Feuille 2 toutes les lignes de la Feuille 1 dont la collone X est rouge.
Voici mon code :

----------

Sub FILTRE()

Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long

Sheets("Feuille2").Activate ' feuille de destination

Col = "X"
NumLig = 2
With Sheets("Feuille1")
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 3 To NbrLig
If .Cells(Lig, Col).Interior.Color = vbRed Then

.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Sheets("Feuille2").Cells(NumLig, 1).Insert Shift:=xlDown

End If
Next
End With

----------

Le script marche, mais il copie toutes les lignes....
Une idee de l'erreur ?
Configuration: Windows XP Internet Explorer 7.0

3 réponses

  1.
    hich24 Messages postés 1686 Statut Membre 753
     
    il faut essayer de mettre la colonne par son numero 24
    cells(lg.24)
    0
  2. Andreaa
     
    J'ai change la formule, mais j'ai le meme resultat
    Voici le changement :

    Sub FiltreLuLu()

    Dim Lig As Long
    Dim Col As Integer
    Dim NbrLig As Long
    Dim NumLig As Long

    Sheets("TEST").Activate ' feuille de destination

    Col = 32 ' colonne données non vides à tester - AF'
    NumLig = 2 'N° de la 1er ligne de données en comptant la ligne 1 = 0 .... ? '
    With Sheets("QUOTE AND PO TRACKING") ' feuille source'
    NbrLig = .Cells(65536, Col).End(xlUp).Row
    For Lig = 3 To NbrLig 'n° de la 1ere ligne de données'
    If .Cells(Lig, Col).Interior.Color = RGB(255, 0, 0) Then
    .Cells(Lig, Col).EntireRow.Copy
    NumLig = NumLig + 1
    Sheets("TEST").Cells(NumLig, 1).Insert Shift:=xlDown
    'ici pour insérer ou .Paste pour coller'
    End If
    Next
    End With

    End Sub
    0
  3. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
     
    Bonjour,

    ton code marche chez moi...
    eric
    0