Supp ligne si cellule contient "X"

Pedro' · 7 Juin 2005

Bonjour à tous,

J’ai un tableau avec 4 colonnes pouvant contenir 4 infos différentes (X,Y,Z,W)
Exemple :
c1 c2 c3 c4
X Y Z W
W
X Z
Z Y W
X Z W Y

J’aimerai copier dans un autre tableau la ligne entière si une des 4 cellules de la ligne contient « X » par exemple.
Comment puis-je m’y prendre pour faire cette macro.

Merci d’avance

Pedro' · 8 Juin 2005

Tout ça m'a l'air pas mal du tout mais moi en tant que novice j'arrive pas à les faire fonctionner. Pouvez- vous m'expliquer le détail de la solution la plus rapide afin que je l'adapte à mon tableau.

Merci beaucoup....

Pedro' · 8 Juin 2005

Voilà mon tableau pour expliquer. A partir de la feuille « W » je veux copier les lignes contenant « GEPSA » sur la feuille « GEPSA », les lignes contenant « SIIS » sur la feuille « SIIS »,…. Les données pouvant se trouver uniquement dans les colonnes E, F, G ou H.

Merci d’avance ça m’aiderait beaucoup si vous pouviez me l’adapter à mon problème.

Pedro' · 8 Juin 2005

Avec le fichier c'est mieux...

Pedro' · 8 Juin 2005

Je suis vraiement gland [file name=Suppr_ligne_cellule.zip size=7509]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Suppr_ligne_cellule.zip[/file]

_Thierry · 8 Juin 2005

Bonjour à tous

Une première approche sur ton dernier fichier Pedro pour voir si j'ai bien compris... Au fait Hervé, j'ai ré-utilisé ton tableau, mais tu le Redim en base 1, alors qu'il semble être en base 0...

Option Explicit

Sub TheRecuperator()
Dim TimeStart As Long
Dim Tablo As Variant
Dim Tablo2() As String
Dim Item As Variant
Dim L As Integer
Dim C As Byte

Dim x As Integer, i As Integer, j As Integer, k As Integer

TimeStart = Timer

With Sheets('W')
Tablo = .Range('E1:H' & .Range('a65536').End(xlUp).Row) '<=== à adapter
End With

For i = 1 To UBound(Tablo)
    For j = 1 To 4
        For Each Item In Array('St AGNES', 'SIIS', 'GEPSA', 'ETAPE')
        If Not IsError(Tablo(i, j)) Then
            If Tablo(i, j) = Item Then
                ReDim Preserve Tablo2(5, x)
                    For k = 0 To 3
                        Tablo2(k, x) = Tablo(i, k + 1)
                    Next k
                        Tablo2(4, x) = Item
                x = x + 1
            End If
        End If
        Next Item
    Next j
Next i

For i = 0 To UBound(Tablo2, 2)
    For Each Item In Array('St AGNES', 'SIIS', 'GEPSA', 'ETAPE')
        If Tablo2(4, i) = Item Then
            With Sheets(Item)
            L = .Range('A5000').End(xlUp).Row + 1
                For C = 0 To 3
                      .Cells(L, C + 1) = Tablo2(C, i)
                Next
            End With
        End If
    Next Item
Next i

MsgBox 'Durée d'Exécution ' & Timer - TimeStart
End Sub

Je file au bureau je suis ultra à la bourre

Bonne Journée
@+Thierry

ChTi160 · 8 Juin 2005

Re:Supp ligne si cellule contient \"X\"

Salut Pedro
Bonjour le Fil
Bonjour le Forum

1° Première Question où et quand se fait le Supp ligne si cellule contient 'X'

Hervé et @Thierry ont fait un travail super concernant cette suppression de lignes
qui c’est transformée en transfert de Données Lol
ATTENTION à la formulation des Questions.
2° Question si on transfert, on supprime les Lignes transférées ????
Merci de nous tenir au courant

PS OUPSSSSSSSS Salut @+THIERRY
Bonne Journée

Message édité par: Chti160, à: 08/06/2005 09:05

Hervé · 8 Juin 2005

Bonjour tout le monde

Thierry,

J'aime bien ta macro.

LOOOOOOOOL

Salut

Pedro' · 8 Juin 2005

Effectivement mon titre était mal choisi c'est plutot un transfert de ligne qu'une suppression.

Pour ce qui est de la suppression de ligne elle peut se faire à la fin de la macro lorsque toutes les lignes ont été transférée.

Pedro' · 8 Juin 2005

Je dois vraiment être nul parce que moi la macro de Thierry bloque sur 'With Sheets(Item)'

Quelqu'un peut-il me dire pourquoi please...

Promi après je vous laisse tranquille

Pedro' · 8 Juin 2005

Excellent ! ! Ok j'ai rien dit la macro marche très bien autant pour moi.

Le seul problème est qu'elle ne copie que les les 4 colonnes avec les critères dedans alors que moi je voudrais récupérer toute la ligne à chaque fois....

Merci

ChTi160 · 8 Juin 2005

Re:Supp ligne si cellule contient \"X\"

re Pedro
ben dit donc
Pedro a dit à @+Thierry et Hervé

données pouvant se trouver uniquement dans les colonnes E, F, G ou H.

et qu'est ce qu'il à fait @+Thierry??????
il a transferé uniquement les Données des colonnes E,F,G,H
il est terrible ce @+Thierry Lol
une nouvelle fois ATTENTION!!!!
avec Hervé et @Thierry tu aurais eu la bonne réponse HIER
Looooool

Message édité par: Chti160, à: 08/06/2005 09:39

_Thierry · 8 Juin 2005

Hello Pedro

Je viens d'arriver au bureau, je t'arrange ça dès que j'ai fait mes tâches habituelles.

@+Thierry

Pedro' · 8 Juin 2005

Oui je voulais dire que les critères pouvaient se trouver dans ces 4 colonnes mais effectivement il fallait copier toute la ligne. Oui j'ai un peu de mal à m'exprimer clairement.

Encore autant pour moi...

En tout cas merci à tous pour l'aide ça me fais gagner beaucoup beaucoup de temps.

Merci.

ChTi160 · 8 Juin 2005

re Pedro
Ici on est une équipe, alors je me suis permis de Modifier le Fichier de @+Thierry pour qu'il remplisse le cahier des Charges Lol
il ne m'en voudras pas !!!,Eh puis c'est de sa faute maintenant je me Lance Lol
j'ai ajouté un petit Bouton pour le Fun Lol [file name=Suppr_ligne_celluleV2.zip size=17009]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Suppr_ligne_celluleV2.zip[/file]

_Thierry · 8 Juin 2005

Re:Export MultiSheets si Cellule contient "X"

Re bonjour à tous

Et oui Jean-Marie, j'ai un peu arrangé le sujet... J'ai aussi amélioré le code, plutôt que de passer par des Array 'Fixes' en dûr dans le code :

For Each Item In Array('St AGNES', 'SIIS', 'GEPSA', 'ETAPE')

Ce qui peut être source de Bug si la feuille n'existe pas...

Donc la il suffit de créer des Feuilles au nom recherché dans les colonnes de E à H de la Sheets ('W') ... Par exemple pour tester tape 'Toto' n'uimporte où en E ou F ou G ou H, puis ajoute une feuille 'TOTO'...

Enfin voilà la 'Bête' :

Option Explicit
Option Compare Text

Sub TheRecuperator()
Dim TimeStart As Long
Dim WS As Worksheet
Dim WSArray() As Variant
Dim TabloPlage As Variant
Dim TabloData() As String
Dim Item As Variant
Dim L As Integer, x As Integer
Dim C As Byte, Col As Byte, y As Byte
Dim WSSource As Worksheet
TimeStart = Timer

Set WSSource = ThisWorkbook.Worksheets('W')

With WSSource
TabloPlage = .Range('A1:H' & .Range('a65536').End(xlUp).Row) '<=== à adapter
End With

For Each WS In ThisWorkbook.Worksheets
    If WS.Name <> WSSource.Name Then
        ReDim Preserve WSArray(x)
        WSArray(x) = WS.Name
        x = x + 1
    End If
Next

For L = 1 To UBound(TabloPlage)
    For C = 1 To 8
        For y = 0 To UBound(WSArray)
        If Not IsError(TabloPlage(L, C)) Then
            If TabloPlage(L, C) = WSArray(y) Then
                ReDim Preserve TabloData(8, x)
                    For Col = 0 To 7
                        TabloData(Col, x) = TabloPlage(L, Col + 1)
                    Next Col
                        TabloData(8, x) = WSArray(y)
                        x = x + 1
            End If
        End If
        Next y
    Next C
Next L

For x = 0 To UBound(TabloData, 2)
    For y = 0 To UBound(WSArray)
        If TabloData(8, x) = WSArray(y) Then
            With Sheets(WSArray(y))
            L = .Range('A35000').End(xlUp).Row + 1
                For C = 0 To 7
                      .Cells(L, C + 1) = TabloData(C, x)
                Next
            End With
        End If
    Next y
Next x

MsgBox 'Durée d'Exécution ' & Timer - TimeStart
End Sub

Bon je vous laisse, j'ai du taf...
@+Thierry

Supp ligne si cellule contient "X"

Pedro'

Guest

Pedro'

Guest

Pedro'

Guest

Pedro'

Guest

Pedro'

Guest

Pièces jointes

_Thierry

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Hervé

XLDnaute Barbatruc

Pedro'

Guest

Pedro'

Guest

Pedro'

Guest

ChTi160

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

Pedro'

Guest

ChTi160

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

Discussions similaires