classer des lignes par dates dans une autre feuille

Private Sub CommandButton1_Click()
Dim n As Byte
n = Application.CountIf(Columns("B"), "Alerte!")
With Sheets("Feuil2")
  .Cells.Clear
  Cells.Copy .Cells
  .Rows("3:65536").Sort Key1:=.Range("I3"), Order1:=xlAscending, Header:=xlNo
  .Rows("3:" & n) = .Rows("3:" & n).Value
  .Rows(n + 3 & ":65536").Delete
End With
End Sub

Private Sub CommandButton1_Click()
  Dim DerLig As Long, DerLigD As Long, Lig
  Dim ShtD As Worksheet
  ' Définir la feuille de destination
  Set ShtD = Sheets("Feuil2")
  ' Effacer la feuille 2 avant la copie
  DerLigD = ShtD.Range("C" & Rows.Count).End(xlUp).Row
  If DerLigD > 2 Then
    ShtD.Range("A3:L" & DerLigD + 1).Clear
  End If
  ' Avec la feuille source
  With Sheets("Feuil1")
    DerLig = .Range("C" & Rows.Count).End(xlUp).Row
    For Lig = 3 To DerLig
      If .Range("B" & Lig).Value = "Alerte!" Then
        ' Trouver la dernière ligne utilisée
        DerLigD = ShtD.Range("C" & Rows.Count).End(xlUp).Row
        ' Copier la ligne en alerte orange
        .Range("A" & Lig & ":L" & Lig).Copy
        ' Coller uniquement la valeur et la couleur
        ShtD.Range("A" & DerLigD + 1).PasteSpecial Paste:=xlPasteValues
        ShtD.Range("A" & DerLigD + 1).PasteSpecial Paste:=xlPasteFormats
      End If
    Next Lig
  End With
  ' Trier les lignes de la feuille 2
  With ShtD
    DerLigD = ShtD.Range("A" & Rows.Count).End(xlUp).Row
    .Activate
    .Range("A3:L" & DerLigD).Sort Key1:=.Range("I3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  End With
End Sub

Private Sub CommandButton1_Click()
Dim plage As Range, derlig As Long, lig As Long
Set plage = Intersect(Rows("3:65536"), UsedRange)
If plage Is Nothing Then Exit Sub
derlig = plage.Row + plage.Rows.Count - 1
With Sheets("Feuil2")
  .Cells.Clear
  Cells.Copy .Cells
Set plage = .Range(plage.Address)
plage.Sort Key1:=.Range("I3"), Order1:=xlAscending, Header:=xlNo
  plage = plage.Value
  For lig = derlig To 3 Step -1
    If .Cells(lig, "B") <> "Alerte!" Then .Rows(lig).Delete
  Next
End With
With Sheets("Feuil3")
  .Cells.Clear
  Cells.Copy .Cells
  Set plage = .Range(plage.Address)
  plage.Sort Key1:=.Range("I3"), Order1:=xlAscending, Header:=xlNo
  plage = plage.Value
  For lig = derlig To 3 Step -1
    If .Cells(lig, "A") <> "Alerte!" Then .Rows(lig).Delete
  Next
End With
End Sub

Dim plage As Range, derlig As Long 'mémorise les variables

Private Sub CommandButton1_Click()
Set plage = Intersect(Rows("3:65536"), UsedRange)
If plage Is Nothing Then Exit Sub
derlig = plage.Row + plage.Rows.Count - 1
Copie "Feuil2", 2
Copie "Feuil3", 1
End Sub

Sub Copie(F$, col As Byte)
Dim ligne As Long, plage1 As Range, lig As Long
With Sheets(F)
  ligne = .UsedRange.Row + .UsedRange.Rows.Count
  plage.EntireRow.Copy .Rows(ligne)
  Set plage1 = .Rows("3:" & ligne + derlig)
  For lig = ligne + derlig To 3 Step -1
    If .Cells(lig, col) <> "Alerte!" Then .Rows(lig).Delete 'seules les alertes sont conservées
  Next
  plage1.Sort Key1:=.Range("D3"), Header:=xlNo 'tri sur IMMAT
  For lig = ligne + derlig To 4 Step -1
    If .Cells(lig, "D") = .Cells(lig - 1, "D") Then .Rows(lig).Delete 'suppression des doublons, les commentaires éventuels en AB:AE sont sur la ligne précédente, et sont donc conservés
  Next
  plage1.Sort Key1:=.Range("I3"), Order1:=xlAscending, Header:=xlNo 'tri sur dates MINES
  plage1 = plage1.Value 'suppression des formules
End With
End Sub

Dim plage As Range 'mémorise la variable

Private Sub CommandButton1_Click()
Set plage = Intersect(Rows("3:65536"), UsedRange)
If plage Is Nothing Then Exit Sub
Copie "Feuil2", 2
Copie "Feuil3", 1
End Sub

Sub Copie(F$, col As Byte)
Dim ligne As Long, lig As Long, sup As Range
With Sheets(F)
  ligne = .UsedRange.Row + .UsedRange.Rows.Count
  plage.EntireRow.Copy .Rows(ligne)
  .UsedRange = .UsedRange.Value 'supprime les formules
  [COLOR="Red"].Rows("3:65536").Sort Key1:=.Columns(col), Order1:=xlDescending, Header:=xlNo 'tri sur la colonne des alertes
  lig = Application.CountIf(.Columns(col), "Alerte!") + 3 '1ère ligne sans alerte
  .Rows(lig & ":65536").Delete 'supprime les lignes sans alerte[/COLOR]
  .Rows("3:65536").Sort Key1:=.Columns("D"), Header:=xlNo 'tri sur IMMAT
  For lig = 4 To lig - 1
    If .Cells(lig, "D") = .Cells(lig - 1, "D") Then _
      [COLOR="Red"]Set sup = Union(.Rows(lig), IIf(sup Is Nothing, .Rows(lig), sup))[/COLOR] 'les commentaires éventuels en AB:AE sont sur la ligne précédente, et seront donc conservés
  Next
  If Not sup Is Nothing Then sup.Delete 'supprime les doublons
  .Rows("3:65536").Sort Key1:=.Columns("I"), Order1:=xlAscending, Header:=xlNo 'tri sur dates MINES
End With
End Sub