Supprimer nbr lignes EXCEL VBA

Bonjour,

J'ai un fichier excel qui se présente comme suit, sur beaucoup plus de lignes:

A1 blablablablabalablabla B1 ATP
A2 blablablablabla
A3 blabalbalbalblabal
A4 balbalbalbalbalballbblbla
A5
A6 blablablabalblabalbal B6 AAA
A7 blablablabalbal
A8 balbalbal
A9
A10 blabalbalbalbalblbalbalbal B10 ATP
A11 balbalbalbalbalbalbla
A12 balbalbalbalblabalbal
etc
etc

Et je voudrais que si la cellule en B contient ATP, supprimer toutes les lignes jusqu'à la ligne vide.
Puis refaire le test sur la ligne suivante.

Merci pour votre aide

6 réponses

  1. Contributeur
    Bonjour tout le monde,

    Une autre proposition :
    Sub suppLig()
        Dim c As Range
        Set c = [B:B].Find("ATP", LookIn:=xlValues)
        While Not c Is Nothing
            Cells(c.Row, 1).Resize(Cells(c.Row, 1).End(xlDown).Row - c.Row + 2, 1).EntireRow.Delete
            Set c = [B:B].Find("ATP", LookIn:=xlValues)
        Wend
    End Sub


    eric
    0
    1. Bonjour Eric et Melanie,

      Merci pour votre aide,
      J'avoue que je ne comprends pas trop vos macro mais c'est celle d'Eric qui fonctionne le mieux pour mon tableau.
      Si maintenant je veux dire q si la date en C est inférieure à la date du jour en D2 ET B="APT" est ce que je peux faire comme ça :

      Sub suppLig()

      Dim c As Range
      Dim d As RAnge
      Dim e As Range

      Set c = [B:B].Find("ATP", LookIn:=xlValues)
      Set d = [C:C]
      Set e =[D2]

      If While Not c Is Nothing and d<e then
      Cells(c.Row, 1).Resize(Cells(c.Row, 1).End(xlDown).Row - c.Row + 2, 1).EntireRow.Delete
      Set c = [B:B].Find("ATP", LookIn:=xlValues)
      Wend
      End If

      End Sub

      Je suis encore une quiche en macro et j'ai du mal à comprendre Dim As Range et compagnie alors si vous pourriez m'expliquer un peu par la même occasion ce serait sympa.

      Sheebie
      0
      1. J'ai essayé et ça ne fonctionne pas donc si vous avez des idées je suis preneuse.
        Merci d'avance
        0
    2. Vraiment désolée de vous embrouiller comme ça. Je me suis trompée.
      En fait je voudrais juste q si la date en C est antérieure à la date du jour, supprimer le paragraphe.

      Merci pour votre compréhension
      0
      1. Contributeur
        Bonjour,

        Réfléchi bien encore un peu et lorsque tu seras sûre repose la question complète

        eric
        0
        1. Bonjour,

          J'ai bien réfléchi et j'ai donc besoin de faire la chose suivante :
          Avec un tableau de la forme :

          A1 blablablablabalablabla B1 date 1 C1 date du jour + heure
          A2 blablablablabla
          A3 blabalbalbalblabal
          A4 balbalbalbalbalballbblbla
          A5
          A6 blablablabalblabalbal B6 date 2

          Je voudrais supprimer le paragraphe si la date en B est antérieure à la date du jour.

          Merci d'avance pour votre aide
          0
          1. Contributeur
            Bonsoir,

            Comme tu ne l'as pas précisé j'ai supposé qu'en B il n'y avait que la date et qu'il ne fallait donc pas tenir compte de l'heure.
            Je me sers quand même de C1, bien que ce soit inutile si c'est réellement la date du jour en cours (on peut le mettre en dur dans le code)

            Essaie avec ça :
            Sub supprimeLignes()
                Dim lig As Long, dateMax As Date, r
                dateMax = Int([C1])
                Application.ScreenUpdating = False
                For lig = [B65536].End(xlUp).Row To 1 Step -1
                    If IsDate(Cells(lig, 2)) And Cells(lig, 2) < dateMax Then
                        Cells(lig, 1).Resize(Cells(lig, 1).End(xlDown).Row - lig + 1, 1).EntireRow.Delete
                    End If
                Next lig
                Application.ScreenUpdating = True
            End Sub
            


            eric
            0
        2. bonjour,

          via une macro

          sub suppression ()

          i=1

          cells(i,60).select
          ActiveCell.FormulaR1C1 = "=SEARCH(""atp"",RC[-2],1)"
          selection.copy
          range(cells(i,60),cells(19999,60)).select
          activesheet.paste

          do while i < 20000 'fonctionnera jusqu'à la 20000eme lignes
          if iserror(cells(i,60) then
          cells(i,60) =""
          i=i+1
          else
          a=i
          do while cells(i,2)<>""
          i=i+1
          loop
          range(rows(a),rows(i)).select
          Selection.Delete Shift:=xlUp
          end if
          loop

          end sub
          -2