Supprimer contenue de la case du dessous.

Sub SupprLignes()
Dim Num_Lignes(), DL As Long, i As Long, Flag As Boolean, Wsh As Worksheet, PlageDeRecherche As String

'--------------------A ADAPTER
Const Col As Byte = 3 'numéro de la colonne concernée (ici C)
Const LignDeb As Byte = 2 'numéro de la première ligne colonne C
Const Texte As String = "Commencé le"
Set Wsh = Sheets("Feuil1") ' A ADAPTER le nom de la feuille concernée
'-----------------------------------------------------------------

With Wsh
   DL = .Columns(Col).Find("*", , , , xlByColumns, xlPrevious).Row
   PlageDeRecherche = .Range(.Cells(LignDeb, Col), .Cells(DL, Col)).Address
   
   Flag = FindAll(Texte, Wsh, PlageDeRecherche, Num_Lignes())
   
   If Flag Then
      For i = 1 To UBound(Num_Lignes)
         .Cells(Num_Lignes(i) + 1, Col) = ""
      Next i
   End If
End With
End Sub

Function FindAll(ByVal sText As String, ByRef oSht As Worksheet, ByRef sRange As String, ByRef arMatches()) As Boolean
On Error GoTo Err_Trap
Dim rFnd As Range, iArr As Integer, rFirstAddress
Erase arMatches
Set rFnd = oSht.Range(sRange).Find(what:=sText, LookIn:=xlValues, lookAt:=xlPart)
If Not rFnd Is Nothing Then
   rFirstAddress = rFnd.Address
   Do Until rFnd Is Nothing
      iArr = iArr + 1
      ReDim Preserve arMatches(iArr)
      arMatches(iArr) = rFnd.Row
      Set rFnd = oSht.Range(sRange).FindNext(rFnd)
      If rFnd.Address = rFirstAddress Then Exit Do
   Loop
   FindAll = True
Else
   FindAll = False
End If
Err_Trap:
If Err <> 0 Then
   MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"
   Err.Clear
   FindAll = False
   Exit Function
End If
End Function

Sub Suppr_Qttes()
Dim Tabl(), DL As Long, i As Long

'--------------------A ADAPTER
Const Col As Byte = 6 'numéro de la colonne concernée (ici F)
Const LignDeb As Byte = 2 'numéro de la première ligne colonne F
With Sheets("Feuil1") ' A ADAPTER le nom de la feuille concernée
'-----------------------------------------------------------------

   DL = .Columns(Col).Find("*", , , , xlByColumns, xlPrevious).Row
   Tabl = .Range(.Cells(LignDeb, Col), .Cells(DL, Col)).Value
   For i = 1 To UBound(Tabl)
      If Tabl(i, 1) <> "Qté:" Then Tabl(i, 1) = ""
      'variante si erreur de saisie (exemple Qté : au lieu de Qté:)
      'If Not Tabl(i, 1) Like "*Qté*" Then Tabl(i, 1) = ""
   Next i
   .Cells(LignDeb, Col).Resize(UBound(Tabl), 1) = Tabl
End With
End Sub