Supp ligne si cellule contient "X"

[Pedro']

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']

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']

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']

Avec le fichier c'est mieux...

 

[Pedro']

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]

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)
&nbsp; &nbsp; For j = 1 To 4
&nbsp; &nbsp; &nbsp; &nbsp; For Each Item In Array('St AGNES', 'SIIS', 'GEPSA', 'ETAPE')
&nbsp; &nbsp; &nbsp; &nbsp; If Not IsError(Tablo(i, j)) Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If Tablo(i, j) = Item Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ReDim Preserve Tablo2(5, x)
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; For k = 0 To 3
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Tablo2(k, x) = Tablo(i, k + 1)
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Next k
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Tablo2(4, x) = Item
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; x = x + 1
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End If
&nbsp; &nbsp; &nbsp; &nbsp; End If
&nbsp; &nbsp; &nbsp; &nbsp; Next Item
&nbsp; &nbsp; Next j
Next i

For i = 0 To UBound(Tablo2, 2)
&nbsp; &nbsp; For Each Item In Array('St AGNES', 'SIIS', 'GEPSA', 'ETAPE')
&nbsp; &nbsp; &nbsp; &nbsp; If Tablo2(4, i) = Item Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; With Sheets(Item)
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; L = .Range('A5000').End(xlUp).Row + 1
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; For C = 0 To 3
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .Cells(L, C + 1) = Tablo2(C, i)
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Next
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End With
&nbsp; &nbsp; &nbsp; &nbsp; End If
&nbsp; &nbsp; 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]

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é]

Bonjour tout le monde

Thierry,


J'aime bien ta macro.

LOOOOOOOOL

Salut

 

[Pedro']

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']

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']

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]

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]

Hello Pedro

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

@+Thierry

 

[Pedro']

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]

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]

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
&nbsp; &nbsp; If WS.Name <> WSSource.Name Then
&nbsp; &nbsp; &nbsp; &nbsp; ReDim Preserve WSArray(x)
&nbsp; &nbsp; &nbsp; &nbsp; WSArray(x) = WS.Name
&nbsp; &nbsp; &nbsp; &nbsp; x = x + 1
&nbsp; &nbsp; End If
Next





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

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

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

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