Macro Excel - Suppression ligneS

Question

Bonjour à tous, 

J'ai actuellement une macro qui supprime la ligne que je sélectionne (et qui la supprime sur toutes les autres feuilles) avec message de confirmtion avant éxécution. Tout ça c'est super !
Mais voilà le soucis, dès que je sélectionne plusieurs lignes, ça ne fonctionne, pas, ca n'en supprime qu'une...
Voici ma macro :

Sub SuppLigne()
If MsgBox("Suppression irréversible. Souhaitez-vous continuer ?", vbQuestion + vbYesNo, "Suppression de la ligne") = vbYes Then
    Dim Lig As Long
    Sheets("Modèle").Select
    Lig = ActiveCell.Row
    Rows(Lig).Delete
    Sheets("Résultat").Rows(Lig).Delete
    Sheets("Constantes").Rows(Lig).Delete
    Sheets("PVT Mensuels").Rows(Lig).Delete
    Sheets("API").Rows(Lig).Delete
End If
End Sub

Quelqu'un a -til une idée ?
Merci de votre aide

pilas31 · Answer

Bonjour,

Bon j'ai une proposition que je trouve un peu compliquée mais bon.

Le principe est de constituer un tableau des lignes à supprimer puis de parcourir ce tableau dans l'ordre inverse (bien sur) et de supprimer les lignes.

On peut selectionner même des cellules non adjacentes et une ou  plusieurs sur la même ligne, ça fonctionne.



Sub SuppLigne()
Dim Lig As Long, NbLig As Long, Ilig As Long
Dim Cellule As Range
Dim TabLig() As Long
If MsgBox("Suppression irréversible. Souhaitez-vous continuer ?", vbQuestion + vbYesNo, "Suppression de la ligne") = vbYes Then
    Lig = 0
    NbLig = 0
    For Each Cellule In Selection
        If Cellule.Row <> Lig Then
            NbLig = NbLig + 1
            ReDim Preserve TabLig(NbLig)
            Lig = Cellule.Row
            TabLig(NbLig) = Lig
        End If
    Next Cellule
    For Ilig = NbLig To 1 Step -1
            Lig = TabLig(Ilig)
            Sheets("Modèle").Rows(Lig).Delete
            Sheets("Résultat").Rows(Lig).Delete
            Sheets("Constantes").Rows(Lig).Delete
            Sheets("PVT Mensuels").Rows(Lig).Delete
            Sheets("API").Rows(Lig).Delete
    Next Ilig
End If
End Sub

Macro Excel - Suppression ligneS

1 réponse

Discussions similaires

Newsletters