Option Explicit
Private Sub CommandButton1_Click()
Dim Rw As Range
Dim Ligne As Long
Dim derLi As Long
Dim r As Long
' Sélectionne l'ensemble des données (utile pour qu'Excel ne "réfléchisse" pas sur les 65000 lignes)
Sheets("Feuil1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select
' Boucle qui va passer sur chaque ligne de la sélection afin de déterminer si des lignes contiennent le flag voulu
' puis copie dans une deuxième feuille de calcul
For Each Rw In Selection.Rows
Ligne = Rw.Row
If Rw.Cells(1, 8).Value >= 25 Then
Rw.Select
Selection.Copy
'Rows("15:15").Select
Selection.Insert Shift:=xlDown
ActiveSheet.Paste
Application.CutCopyMode = False
Range("H15").Select
ActiveCell.FormulaR1C1 = "=R[-1]C-25"
Range("H15").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Range("H14").Select
ActiveCell.FormulaR1C1 = "25"
Range("H15").Select
End If
Next Rw
' Supression des lignes vierges dans les feuilles de calcul récemment constituées
Sheets("Feuil1").Activate
With ActiveSheet.UsedRange
derLi = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For r = derLi To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
MsgBox "Le fichier est prêt.", vbOKOnly, "Macro terminée"
End Sub