Macro suppression lignes

[Jultra]

Rebonjour au Forum,

J'ai besoin de votre aide. J'espère que je vais être clair, car ce n'est pas évident!

Je dispose d'une base de données dans une page "Prog General". Je la trie selon un critère et je positionne chaque ligne dans 1 des 7 autres pages de mon fichier.

Les lignes se positionnent sur la même ligne que celle de la base de données.
Du coup je peux avoir plusieurs lignes vides sur les 7 pages.
Je désire les supprimer par la macro Sub suppression_lignes_vides().

Le programme marche au début mais ensuite comme je fais m=m-1 (car il peut y avoir plusieurs lignes vides à la suite), il tourne dans le vide car il n'atteint jamais l'indice de la dernière ligne.

J'espère que vous avez compris et que quelqu'un pourra m'aider ou me conseiller au moins.
Merci d'avance!


Voici la partie du programme concernée:

Function indice_derniere_ligne() As Integer
Sheets("Prog General").Select
Dim n As Integer
n = 2
While Not (IsEmpty(Cells(n, "A")))
n = n + 1
Wend
indice_derniere_ligne = n - 1

MsgBox "indice derniere ligne" & n - 1

End Function

Sub suppression_lignes_vides()

Dim m As Integer

For m = 2 To indice_derniere_ligne
Sheets("L100").Select
If Cells(m, "A") = "" Then
Range(Cells(m, "A"), Cells(m, "E")).Select
Selection.Delete Shift:=xlUp
m = m - 1
Else
End If
Next

Range("A1").Select

End Sub

 

[Pascal76]

Bonjour

essaies juste cette macro sans ta fonction

Sub suppression_lignes_vides()

Dim m As Integer

Application.ScreenUpdating = False

For m = Sheets("L100").Range("A65536").End(xlUp).Row To 2 Step -1
If Sheets("L100").Range("A" & m) = "" Then
Rows(m).EntireRow.Delete
End If
Next

Range("A1").Select

Application.ScreenUpdating = True

End Sub

Bon courage

Pascal

 

[Safety85]

Bonjour,

Tu peux essayer cette macro aussi, elle fonctionne sans limite d'un nombre de ligne.

Sub SuppressionLignes()
fin = ActiveSheet.UsedRange.Rows.Count
Range("a1").Select
ActiveCell.Offset(fin - 1, 0).Range("a1").Select
Do While ActiveCell.Row() <> 1
If ActiveCell.Value = "" Then
ActiveCell.EntireRow.Cells().Select
Selection.Delete shift:=xlUp
End If
ActiveCell.Offset(-1, 0).Range("a1").Select
Loop
End Sub

Bon Courage

Safety85

 

[Jultra]

Merci beaucoup Pascal et Safety85, ça m'énervait de ne pas y arriver et maintenant, ça semble marcher!!