Vba Excel : Importer Cellule colorer Feuille

Fermé

Andreaa - 6 août 2009 à 12:01
eriiic Messages postés 24603 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 15 décembre 2024 - 7 août 2009 à 07:37

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 ?

A voir également:

Vba Excel : Importer Cellule colorer Feuille
Liste déroulante excel - Guide
Word et excel gratuit - Guide
Déplacer colonne excel - Guide
Si et excel - Guide
Excel compter cellule couleur sans vba - Guide

3 réponses

Réponse 1 / 3

hich24 Messages postés 1635 Date d'inscription mardi 2 octobre 2007 Statut Membre Dernière intervention 1 février 2025 753
6 août 2009 à 12:16

il faut essayer de mettre la colonne par son numero 24
cells(lg.24)

Réponse 2 / 3

Andreaa
6 août 2009 à 12:23

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

Réponse 3 / 3

eriiic Messages postés 24603 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 15 décembre 2024 7 260
7 août 2009 à 07:37

Bonjour,

ton code marche chez moi...
eric