Sélectionner plusieurs lignes et les supprimer

Bonjour à tous,

J'ai réalisé une macro qui me permet de supprimer toutes les lignes dont la colonne A est vide, et ceci pour les lignes 16 à 300. Ma macro fonctionne bien mais elle est très lente à s'exécuter (et ce n'est pas à cause de mon PC).

Voici mon code :

Dim i%

    For i = 300 To 16 Step -1
        If Cells(i, 1) = "" Then Rows(i).Delete
    Next i

Actuellement, mon code supprime les lignes une par une et je pense que c'est cela qui ralentis mon code. Ce que je souhaite faire, ce serait de sélectionner ma ligne, la garder en mémoire, puis sélectionner une autre ligne, la garder également en mémoire (et ainsi de suite) et à la fin, supprimer toutes les lignes gardées en mémoire en une seule fois. Le problème, c'est que je n'ai absolument aucune idée pour faire ça ..

J'attend vos réponses avec impatiente !

Bonjour Callitek le forum

je ne sais pas ce que tu appelles lent mais bon

voilà déjà une modif à effectuer

Dim i%
application.screenupdating=0
    For i = 300 To 16 Step -1
        If Cells(i, 1) = "" Then Rows(i).Delete
    Next i

tu modifies comme cela et tu vérifies

a+

Papou

Bonjour Callitek, paritec

Essaye avec un filtre, sa devrait être beaucoup plus rapide :

Sub erase_data()

derlgn = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range("$A$15:$A$" & derlgn).AutoFilter Field:=1, Criteria1:=""
Range("$A$16:$A$" & derlgn).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False

End Sub

Slt,

encore un essai

Sub Callitek()
  With Range("A16:A300")
    .SpecialCells(xlBlanks).EntireRow.Delete
  End With
End Sub

Merci les gars,

J'ai utilisé le filtre et c'est beaucoup plus rapide, c'est même intantané !!!

Par contre, quelqu'un peut juste m'expliquer ce qu'il s'est passé exactement ?

derlgn = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range("$A$15:$A$" & derlgn).AutoFilter Field:=1, Criteria1:=""
Range("$A$16:$A$" & derlgn).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False

En tous cas, ça fonctionne merci !

En gros le code efface toute la sélection qui réponds aux critères, sa évite de prendre ligne par ligne.

Cette méthode est comme tu dis instantanées et à utilisé en priorité lors de long traitement.

J'ai un petit souci avec ton code, et je ne comprend pas pourquoi ..

Voilà, j'utilise ton code dans deux macros, la première, le code fonctionne très bien et la seconde, j'ai une erreur qui s'active (erreur d'exécution 1004 : erreur définie par l'application ou par l'objet). Et puis, l'erreur ne se met pas toujours en place, c'est très bizarre.

Et pour finir, si j'exécute la macro plusieurs fois, il me supprrime toute ma feuille sauf une ligne alors que la macro ne mentionne pas ces lignes ..

Voici le code qui fonctionne :

Sub importer_les_donnees()

Application.ScreenUpdating = False

Dim dernlgn As Integer

'Etirer les cellules
Range("A15").AutoFill Destination:=Range("A15:A300")
Range("B15").AutoFill Destination:=Range("B15:B300")

'Supprimer les lignes vides
derlgn = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range("$A$15:$A$" & derlgn).AutoFilter Field:=1, Criteria1:=""
Range("$A$16:$A$" & derlgn).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False

'Mise en forme conditionnelle
    For i = 100 To 16 Step -1
        If Cells(i, 1) <> "" Then Range("A" & i, "B" & i).Borders.Weight = xlThin
        If Cells(i, 1) <> "" Then Range("C" & i, "D" & i).Borders.Weight = xlThin
        If Cells(i, 1) <> "" Then Range("E" & i).Borders.Weight = xlThin

    Next i

Application.ScreenUpdating = True

End Sub

Voici le second code :

Sub MAJ_feuille_de_mission()

Dim derlgn As Integer

derlgn = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range("$A$15:$A$" & derlgn).AutoFilter Field:=1, Criteria1:=""
Range("$A$16:$A$" & derlgn).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False

End Sub

Bonjour Callitek,

L’erreur que tu peux retrouver et dans le cas ou tu te retrouves avec aucune lignes à supprimer, voici une modif du code afin de continuer la procédure si aucune ligne est égal à "" .

Sub importer_les_donnees()
    Dim dernlgn As Integer

    Application.ScreenUpdating = False

    Set sh = ActiveSheet
    'Etirer les cellules
    sh.Range("A15:B15").AutoFill Destination:=sh.Range("A15:B300")

    'Déclaration des variables
    derlgn = sh.Cells(Rows.Count, 1).End(xlUp).Row

    'Supprimer les lignes vides
    sh.Range("$A$15:$A$" & derlgn).AutoFilter Field:=1, Criteria1:=""
    nbligne = sh.Range("$A$15:$A$" & derlgn).SpecialCells(xlCellTypeVisible).Count - 1
    If nbligne = 0 Then MsgBox ("Aucune à supprimer"): GoTo svt
    sh.Range("$A$15:$A$" & derlgn).SpecialCells(xlCellTypeVisible).EntireRow.Delete
svt:
    ActiveSheet.AutoFilterMode = False

    'Mise en forme conditionnelle
        For i = 100 To 16 Step -1
            If sh.Cells(i, 1) <> "" Then sh.Range(sh.Cells(i, 1), sh.Cells(i, 5)).Borders.Weight = xlThin
        Next i

    Application.ScreenUpdating = True

End Sub

Super merci, ça fonctionne !!