Supprimer des lignes selon un critère déterminé avec une macro VBA

[RTS001]

Bonjour,

Je voudrais :
- supprimer les lignes de ma colonne "A" qui sont vides (par exemple si la cellule A3 est vide alors supprimer toute la ligne) ;
- supprimer toutes les lignes différentes d'un critère qui est : "E201*******" (les étoiles correspondent à 7 chiffres qui ne sont pas fixes mais variables (automatiques))
Je m'explique : si une cellule de la colonne A commence par E201 alors garder toute la ligne en question. Si le contenu de la cellule ne commence pas par E201 alors supprimer la ligne.
- garder la ligne 1 vu qu'il s'agit des noms de colonne.

J'espère avoir été assez explicite.

Vous remerciant par avance pour votre aide.

ps : je vous joins le fichier en pièce jointe pour vous faciliter.
Dans le fichier les données de la colonne "A" s'arrête à la ligne 45 mais cela peut être beaucoup plus.

 

[phlaurent55]

Bonjour RTS001, et bienvenue sur le forum

Voici le code qui répond à ta demande

For i = Range("A65535").End(xlUp).Row To 3 Step -1
If Cells(i, 1) = "" Or Left(Cells(i, 1), 4) <> "E201" Then Rows(i).Delete
Next i

à+
Philippe

 

[RTS001]

Bonjour Phlaurent55,

Cela fonctionne parfaitement merci beaucoup.

J'ai regardé votre code et je l'ai compris ))

Merci encore et bonne journée à vous.

 

[Loub06]

Bonjour RTS001, et bienvenue sur le forum

Voici le code qui répond à ta demande

For i = Range("A65535").End(xlUp).Row To 3 Step -1
If Cells(i, 1) = "" Or Left(Cells(i, 1), 4) <> "E201" Then Rows(i).Delete
Next i

à+
Philippe

Bonjour,
je me suis inspirée de cette réponse pour une macro mais je bute sur un pb :
je souhaite renseigner une DB avec des données saisies dans un formulaire et supprimer ensuite les cellules vides.
La 1ere macro fonctionne bien
*********************************************************************
Sheets("FICHE SORTIE").Range("B46:J57").Select
Selection.Copy
Sheets("RECAP").Select
Range("F2").End(xlDown).Offset(1, -5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
**********************************************************************
Mais avec la 2e macro toutes les lignes suivant la ligne 1 sont supprimées meme si elles contiennent des données
**********************************************************************
Sheets("RECAP").Select
Dim j As Long
For j = Range("F65535").End(xlUp).Row To 3 Step -1
If Cells(j, 1) = "" Then Rows(j).Delete
Next j
*********************************************************************
Merci pour toute suggestion
Elisabeth

 

[Ethiryn - Glarilak]

Bonjour Loub06,

Ton code supprime la ligne si la case de la colonne 1 (A) ligne j est vide.

Sheets("RECAP").Select
Dim j As Long
For j = Range("F65535").End(xlUp).Row To 3 Step -1
    If Cells(j, 1) = "" Then Rows(j).Delete
Next j

Dans ton document les lignes qui sont supprimer ne sont pas renseigner en colonne 1(A). Tu as donc 2 solutions :

Solution 1 : Tu choisis une colonne où tu est sur d'avoir une donner quant tu ne veux pas que la ligne soit supprimer comme par exemple la colonne 8 (H).

Sheets("RECAP").Select
Dim j As Long
For j = Range("F65535").End(xlUp).Row To 3 Step -1
    If Cells(j, 8) = "" Then Rows(j).Delete
Next j

A été changer la valeur dans la fonction Cells.

Solution 2 : Tu t'assures que tu as une information en colonne 2(B) ligne 46 chaque fois que tu fais ton copier coller par macro. Par exemple le code si-dessous ici de ton document, mais modifier.

If Range("$B$46") <> "" Then
    Sheets("FICHE SORTIE").Range("B46:J57").Select
    Selection.Copy
    Sheets("RECAP").Select
    Range("F2").End(xlDown).Offset(1, -5).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
    MsgBox "La cellule B46 de la feuille FICHE SORTIE n'est pas remplie"
End If

A été ajouter la partie condition du if et end if plus le else pour prévenir l'utilisateur.

J'espère avoir répondu à ta question Loub06.

Ethiryn -Glarilak

 

[Loub06]

Bonjour Loub06,

Ton code supprime la ligne si la case de la colonne 1 (A) ligne j est vide.

Dans ton document les lignes qui sont supprimer ne sont pas renseigner en colonne 1(A). Tu as donc 2 solutions :

Solution 1 : Tu choisis une colonne où tu est sur d'avoir une donner quant tu ne veux pas que la ligne soit supprimer comme par exemple la colonne 8 (H).

Sheets("RECAP").Select
Dim j As Long
For j = Range("F65535").End(xlUp).Row To 3 Step -1
    If Cells(j, 8) = "" Then Rows(j).Delete
Next j

A été changer la valeur dans la fonction Cells.

Solution 2 : Tu t'assures que tu as une information en colonne 2(B) ligne 46 chaque fois que tu fais ton copier coller par macro. Par exemple le code si-dessous ici de ton document, mais modifier.

If Range("$B$46") <> "" Then
    Sheets("FICHE SORTIE").Range("B46:J57").Select
    Selection.Copy
    Sheets("RECAP").Select
    Range("F2").End(xlDown).Offset(1, -5).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
    MsgBox "La cellule B46 de la feuille FICHE SORTIE n'est pas remplie"
End If

A été ajouter la partie condition du if et end if plus le else pour prévenir l'utilisateur.

J'espère avoir répondu à ta question Loub06.

Ethiryn - Glarilak

Bonjour Ethiryn - Glarilak,
merci pour ta réponse.
J'ai essayé les 2 suggestions mais arrive toujours au même problème : la copie des données dans la feuille RECAP génère des lignes avec des cellules non vides : ma zone de travail dans la feuille 1 prévoit de copier jusque 12 entrées
et quand je saisis un nouveau formulaire il se copie en gardant ces lignes et ma liste est donc remplies de lignes vides.

 

[Ethiryn - Glarilak]

Les lignes à supprimer sont les lignes où il n'y a que des "0" dans les cellules ?

Si oui, il faut éviter qu'il y ait des "0".

Pour cela il faut que les formules de la feuille FICHE SORTIE, dans la zone de travail affiche toujours soit la donnée soit rien (pas de 0).
Exemple de formule en :
- G46 : SI($B20<>"";$B20;"")
- H46 : SI($C20<>"";$C20;"")
- I46 : SI($G46<>"";"NON";"")
Formule à entrer dans la cellule respective et à étirer dans le tableau. A noter qu'elle suivent la même logique que c'est que tu as entrer en E46 pour le salarié.

Si ce sont bien les lignes à supprimer alors cela est censée convenir avec la première solution donner précédemment.

Sheets("RECAP").Select
Dim j As Long
For j = Range("F65535").End(xlUp).Row To 3 Step -1
If Cells(j, 8) = "" Then Rows(j).Delete
Next j

Ethiryn - Glarilak

 

[Loub06]

Les lignes à supprimer sont les lignes où il n'y a que des "0" dans les cellules ?

Si oui, il faut éviter qu'il y ait des "0".

Pour cela il faut que les formules de la feuille FICHE SORTIE, dans la zone de travail affiche toujours soit la donnée soit rien (pas de 0).
Exemple de formule en :
- G46 : SI($B20<>"";$B20;"")
- H46 : SI($C20<>"";$C20;"")
- I46 : SI($G46<>"";"NON";"")
Formule à entrer dans la cellule respective et à étirer dans le tableau. A noter qu'elle suivent la même logique que c'est que tu as entrer en E46 pour le salarié.

Si ce sont bien les lignes à supprimer alors cela est censée convenir avec la première solution donner précédemment.


Ethiryn - Glarilak

Oui ça j'avais essayé. Mais en copiant même si la cellule n'affiche rien elle n'est pas vide. On le voit en sélectionnant les cellules.
D'où mon idée de rechercher la dernière cellule contenant une donnée différente de "" dans la colonne F et de supprimer les lignes suivantes

 

[Ethiryn - Glarilak]

Ton objectif est-il d'obtenir ce que montre les images suivante ?
- Si oui le résultat s'obtient en mettant les formules suivante dans leurs cellules correspondante. Et le code VBA de la solution 2 qui suis.

- G46 : SI($B20<>"";$B20;"")
- H46 : SI($C20<>"";$C20;"")
- I46 : SI($G46<>"";"NON";"")

Sheets("RECAP").Select
Dim j As Long
For j = Range("F65535").End(xlUp).Row To 3 Step -1
  If Cells(j, 8) = "" Then Rows(j).Delete
Next j

Si c'est ce que tu voulais faire mais que tu ne veux pas modifier tes formules cellules, alors tu peut aussi changer la correspondance dans la macro : Cells(j, 8) = "0"
Si c'est ce que tu avais fait, et que tu n'a pas obtenu le bon résultat, peut-tu joindre de nouveau ton fichier pour que je puisse voir ce qui peut encore poser problème.

- Si les images ne montre absolument pas ce que tu veux faire, peut-tu alors mettre une image, ou le classeur en question en mettant d'une autre couleurs (Ex : Vert), les lignes à supprimées sur la feuille RECAP, de manière à pouvoir bien comprendre ce que tu veux faire.

Après plusieurs activation du bouton "ETAPE 2 Enregistrer"

Après avoir cliquer sur le bouton "Etape 3 Remise à zéro formulaire"

 

[Loub06]

Ton objectif est-il d'obtenir ce que montre les images suivante ?
- Si oui le résultat s'obtient en mettant les formules suivante dans leurs cellules correspondante. Et le code VBA de la solution 2 qui suis.


Si c'est ce que tu voulais faire mais que tu ne veux pas modifier tes formules cellules, alors tu peut aussi changer la correspondance dans la macro : Cells(j, 8) = "0"
Si c'est ce que tu avais fait, et que tu n'a pas obtenu le bon résultat, peut-tu joindre de nouveau ton fichier pour que je puisse voir ce qui peut encore poser problème.

- Si les images ne montre absolument pas ce que tu veux faire, peut-tu alors mettre une image, ou le classeur en question en mettant d'une autre couleurs (Ex : Vert), les lignes à supprimées sur la feuille RECAP, de manière à pouvoir bien comprendre ce que tu veux faire.

Après plusieurs activation du bouton "ETAPE 2 Enregistrer"
Regarde la pièce jointe 1038102

Après avoir cliquer sur le bouton "Etape 3 Remise à zéro formulaire"
Regarde la pièce jointe 1038103

Oui ca correspond exactement a ce que je veux obtenir. J'ai du quitter mon boulot. Je ressaierai demain matin
Merci.

 

[Loub06]

Oui ca correspond exactement a ce que je veux obtenir. J'ai du quitter mon boulot. Je ressaierai demain matin
Merci.

Bonjour Ethiryn-Glarilak
Tout fonctionne comme voulu.
Merci pour ton aide.