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

RTS001

XLDnaute Nouveau
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.
 

Pièces jointes

  • test.xlsx
    15.8 KB · Affichages: 109

phlaurent55

Nous a quittés en 2020
Repose en paix
Bonjour RTS001, et bienvenue sur le forum

Voici le code qui répond à ta demande

Code:
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
 

Loub06

XLDnaute Nouveau
Bonjour RTS001, et bienvenue sur le forum

Voici le code qui répond à ta demande

Code:
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
 

Pièces jointes

  • SORTIE MATERIEL DEPOT.xlsm
    64.5 KB · Affichages: 18

Ethiryn - Glarilak

XLDnaute Nouveau
Bonjour Loub06,

Ton code supprime la ligne si la case de la colonne 1 (A) ligne j est vide.
VB:
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).
VB:
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.
VB:
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
 
Dernière édition:

Loub06

XLDnaute Nouveau
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).
VB:
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.
VB:
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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";"")
Code:
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"
1565710713427.png


Après avoir cliquer sur le bouton "Etape 3 Remise à zéro formulaire"
1565710734008.png
 
Dernière édition:

Loub06

XLDnaute Nouveau
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.
 

Discussions similaires

Réponses
22
Affichages
689
Réponses
26
Affichages
790

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 838
dernier inscrit
Christelle.B86