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

Re:Export MultiSheets si Cellule contient "X"

PARFAIT ! ! !

Merci à tous particulièrement à toi Thierry.

Super forum.

Encore Merci.

Pedro'

 

[_Thierry]

Re:Export MultiSheets si Cellule contient "X"

re Bonjour Pedro, Jean Marie, Hervé, le Fil, le Forum

Bon alors ravi d'avoir pu t'aider Pedro.

Pour Jean Marie, je sais bien que tout est de ma faute sur ce Forum !!! LOL et tu n'as pas été le seul a être contaminé par ce terrible fléau qu'est le VBA !!! lol

Par contre Archtung !!!

        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(7, x)
                    For k = 0 To 7
                        Tablo2(k, x) = Tablo(i, k + 1)
                    Next k
                        Tablo2(4, x) = Item
                x = x + 1
            End If
        End If

Tu as Ein Grosss Error en colonne 'E' de toutes les feuilles ensuite...

Sinon oui pas bête l'idée de gérer les erreurs (If i = 1 Then Exit For) , mais dans ce cas je m'y prendrai ainsi :

Option Explicit
Option Compare Text

Sub TheUltimatorRecuperator()
Dim WS As Worksheet
Dim WSArray() As Variant
Dim TabloPlage As Variant
Dim TabloData() As String
Dim L As Integer, x As Integer
Dim C As Byte, Col As Byte, y As Byte, w As Byte
Dim WSSource As Worksheet


Set WSSource = ThisWorkbook.Worksheets('W')

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

If UBound(TabloPlage) <= 1 Then
&nbsp; &nbsp; MsgBox 'Aucune donnée à traîter en Feuille ' & WSSource.Name, vbCritical, 'Et Boum !!! lol @+Thierry'
&nbsp; &nbsp; Exit Sub
End If

For Each WS In ThisWorkbook.Worksheets
&nbsp; &nbsp; If WS.Name <> WSSource.Name Then
&nbsp; &nbsp; &nbsp; &nbsp; ReDim Preserve WSArray(w)
&nbsp; &nbsp; &nbsp; &nbsp; WSArray(w) = WS.Name
&nbsp; &nbsp; &nbsp; &nbsp; w = w + 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

If x = 0 Then
&nbsp; &nbsp; MsgBox 'Aucune donnée correspondante retournée depuis Feuille : ' & WSSource.Name, vbInformation, 'Et Paf !!! lol @+Thierry'
&nbsp; &nbsp; Exit Sub
End If

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
End Sub

Bonne Journée à vous tous mes amis
@+Thierry

 

[ChTi160]

Re:Export MultiSheets si Cellule contient \"X\"

Salut @+Thierry
Bien Mangé Lol
bon toi t'es un bon tu me fais des remarques que j'essaye d'assimiler et toi tu merdes Dans la mise en forme du texte sensé me montrer là ou ca M.... pardon
ensuite tu me dit je m'y prendrais ainsi et tu changes toutes les références ce qui ne m'a pas permis (excuse moi de Comprendre la Leçon Domage)mais bon je vais faire tourner pas à pas et je devrais y arriver .
Merci pour le temps que tu passes à corriger nos erreurs et ainsi nous faire avancer
Bonne fin de Journée

Message édité par: ChTi160, à: 08/06/2005 14:30

 

[_Thierry]

Re:Export MultiSheets si Cellule contient "X"

Re Jean Marie

Ah pardon, oui je n'avais pas fait gaffe à la mise en forme...

En fait ton erreur se Situe dans la Colonne 4 du Tablo2 soit 'E' sur la Feuille...

C'est dû à : Tablo2(4, x) = Item

Car là tu écrases la Colonne 4 alors que ton Tablo2 (Qui est en Base 0) devrait contenir en champs la valeur contenue dans la Colonne 5 de Tablo (qui lui est en Base 1)...

En fait tu as besoin de Redim ce Tablo2 en Base 0 sur 9 colonnes (0 à 8, soit directement 8)
Et de l'indexer séquentiellement :
De 0 à 7 pour les Huit Colonnes Contenues dans le Tablo
et le Champs 8 quant à lui, servira à mémoriser le nom de la Feuille (Item)...

Dans la Version Finale 'TheUltimatorRecuperator' j'ai radicalement changé de nom ces deux tableaux :
TableauPlage = La Plage Entière de 8 Colonnes en Base 1 (De 1 à 8)
TableauData = Les Data Filtrées en 9 Colonnes en Base 0 (De 0 à 7 pour les 8 Colonnes du TableauPlage, plus la Dernière Colonne suplémentaire pour l'Incrémentation du 'WSArray(y)' qui est l'équivalement de 'Item' dans la version précédente)

J'espère que tu as tout suivi ?

Ce qui a dû participer pour te perturber c'est aussi la façon dont Hervé a forcé son Tablo2 en Base 1 (avec ReDim Preserve tablo2(1 To 4, 1 To x)) alors que par défaut les Tableaux Dynamiques Séquentiels sont toujours en Base 0, sauf si l'on déclare Option Base 1... C'est vite fait d'y perdre son latin, pardon son VBA !

Bon enfin bon mal de tête cet aprèm pour toi Jean-Marie

@+Thierry

 

[ChTi160]

Re:Export MultiSheets si Cellule contient \"X\"

re Merci pour ce complément d'info qui m'éclaire

dit Thierry toi qui joue à l'ordi depuis plus longtemps que moi ta du connaitre Excel 97 dans ta jeunesse si tu peux regarder le post que je viens de mettre concernant une erreur 1004 lors du lancement sous excel 97 d'une macro faite sous excel 2002
celà concernerait La methode Find
Ce lien n'existe plus
ma Question
Lien supprimé
Merci d'avance et bonne fin de Journée
tu me diras comme t'es arrivé à la bourre ce matin !!!!!!

Message édité par: Chti160, à: 08/06/2005 16:58

 

[newam]

hmy:
G un soucis qd gh lance ta macro Run Boucle 004
ça me colle l'erreur suivante:::
Erreur d'exécution '13'
incompatibilité de type

é quand je lance le dbogage il me jaunie cette ligne:::
Sheets('Feuil2').Range('a1').Resize(UBound(tablo2, 2), UBound(tablo2, 1)) = Application.Transpose(tablo2)

c koi ce binzzz???
Merci

 

[_Thierry]

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

Re Jean-Marie, le Fil, Bonjour Newam


Pour Jean-Marie réponse toute chaude dans ton Fil...

Pour Newam, ce 'sbinz' se déroule sur quelle machine (Version d'Excel et Windows ?)

Car à priori, cela semble fonctionner pour les autres intervenants de ce Fil, ceux présents et ceux qui sont restés dans l'anonymat sur les 317 visites que ce Sujet a déclenchées...

Bonne Fin de Journée
@+Thierry

Message édité par: _Thierry, à: 08/06/2005 17:23

 

[ChTi160]

re dit donc Colombo ,t'as l'oeil partout 317 Visites
Encore Merci je vais clore le fil dès que le problème sera résolu