Re bonjour
Ouh la ! si c'est sur mac, voici un code pas trés rapide mais extra simple qui tourne sur ton fichier
Sub Sup_Lignes()
Dim Compteur As Long
Application.ScreenUpdating = False
For Compteur = Range("A1").SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If Left(Range("A" & Compteur).FormulaR1C1 , 1 )= "4" Then
Rows(Compteur & ":" & Compteur).Delete
End If
Next Compteur
End Sub
sinon code beaucoup plus rapide mais plus compliqué, tourne également sur ton fichier
Sub Supprimer_Lignes()
'définition des variables
Dim Tab_Cells As Variant, Tab_Row() As String, Mem_Row As Long
Dim Cellule_Debut As Range, Cellule_Fin
Dim Deb_Tab As Long, Compteur As Long, Compteur2 As Long, Compteur3 As Long
'désactivation de l'affichage écran pour gagner en rapidité
Application.ScreenUpdating = False
With ActiveSheet
'indiquer ici la plage de test
'si je désire tester les cellules colonnes A et D sur 6000 lignes la plage sera range("A1
6000")
'la ligne suivante définit le début du tableau de valeurs pour test
Set Cellule_Debut = .Range("A1")
'la ligne suivante définit la fin du tableau de valeurs pour test
'la valeur actuelle correspond à la dernière cellule de la colonne D avec possibilité de valeur
Set Cellule_Fin = Range("A" & Range("A1").SpecialCells(xlCellTypeLastCell).Row)
'mémorise la ligne de début du tableau de valeurs
Mem_Row = Cellule_Debut.Row - 1
'passe les valeurs de cellules au tableau de valeurs
Tab_Cells = .Range(Cellule_Debut.Address & ":" & Cellule_Fin.Address).Value
'initialise les compteurs
Compteur = 0
Compteur3 = 65536
'boucle sur la longueur du tableau
For Compteur2 = LBound(Tab_Cells) To UBound(Tab_Cells)
'indiquer ici la valeur du test et les ou la colonne du tableau, ici 2 car colonnes de test sur A et D
If Left(Tab_Cells(Compteur2, 1), 1) = "4" Then
If Compteur3 < 65536 Then
'indiquer ici les colonnes à supprimer, laisser de A à IV pour lignes entières
Tab_Row(Compteur) = "A" & (Compteur3 + Mem_Row) & ":" & "IV" & (Compteur2 + Mem_Row)
Else
'si première ligne en test ok ou ligne d'avant en test no ok, on incrémentre compteur
Compteur = Compteur + 1
'on redimensionne en conservant les valeurs
ReDim Preserve Tab_Row(1 To Compteur) As String
'indiquer ici la plage à supprimer, laisser de A à IV pour lignes entières
Tab_Row(Compteur) = "A" & (Compteur2 + Mem_Row) & ":" & "IV" & (Compteur2 + Mem_Row)
'on enregistre le numéro de première ligne test ok
Compteur3 = Compteur2
End If
Else
Compteur3 = 65536
End If
Next Compteur2
'on efface les lignes détectées en partant de la fin
For Compteur2 = Compteur To 1 Step -1
'pour test
'Application.ScreenUpdating = True
'.Range(Tab_Row(Compteur2)).Select
'MsgBox Tab_Row(Compteur2)
.Range(Tab_Row(Compteur2)).Delete Shift:=xlUp
Next Compteur2
.Range("A1").Select
End With
MsgBox "fini"
End Sub
A+
