Archivage automatique selon des valeures textes

Option Explicit


Sub Archivage()
    Dim DerL1&, DerL2&, Lig&, DerL3&, DerL4&
    DerL1 = Feuil1.Range("A" & Rows.Count).End(3).Row
    DerL2 = Feuil1.Range("F" & Rows.Count).End(3).Row
    DerL3 = Feuil2.Range("A" & Rows.Count).End(3).Row + 1
    DerL4 = Feuil2.Range("F" & Rows.Count).End(3).Row + 1
    
    'For Lig = DerL1 To 3 Step -1
    '   If Feuil1.Cells(Lig, "C") = "oui" And Feuil1.Cells(Lig, "D") = "oui" Then Feuil1.Range("A" & Lig & ":" & "D" & Lig).Cut Feuil2.Cells(DerL3, 1)
    '    DerL3 = DerL3 + 1
    'Next Lig
    
    For Lig = DerL2 To 3 Step -1
        If Feuil1.Cells(Lig, "K") = "oui" And Feuil1.Cells(Lig, "L") = "oui" Then Feuil1.Range("F" & Lig & ":" & "L" & Lig).Cut Feuil2.Cells(DerL4, 6)
        DerL4 = DerL4 + 1
    Next Lig


    Feuil1.Range("A2:D1000").Select
    ActiveWorkbook.Worksheets("Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add Key:=Range("C3:C1000"), SortOn:=xlSortOnValues, Order:=xlAscending
    With ActiveWorkbook.Worksheets("Data").Sort
        .SetRange Range("A2:D1000")
        .Header = xlYes
        .Apply
    End With
    Feuil1.Range("F2:L1000").Select
    ActiveWorkbook.Worksheets("Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add Key:=Range("J3:J1000"), SortOn:=xlSortOnValues, Order:=xlAscending
    With ActiveWorkbook.Worksheets("Data").Sort
        .SetRange Range("F2:L1000")
        .Header = xlYes
        .Apply
    End With
    Cells(1, 1).Select


    Feuil2.Activate
    Range("A2:D1000").Select
    ActiveWorkbook.Worksheets("Sauvegarde").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sauvegarde").Sort.SortFields.Add Key:=Range("C3:C1000"), SortOn:=xlSortOnValues, Order:=xlAscending
    With ActiveWorkbook.Worksheets("Sauvegarde").Sort
        .SetRange Range("A2:D1000")
        .Header = xlYes
        .Apply
    End With
    Feuil2.Range("F2:L1000").Select
    ActiveWorkbook.Worksheets("Sauvegarde").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sauvegarde").Sort.SortFields.Add Key:=Range("J3:J1000"), SortOn:=xlSortOnValues, Order:=xlAscending
    With ActiveWorkbook.Worksheets("Sauvegarde").Sort
        .SetRange Range("F2:L1000")
        .Header = xlYes
        .Apply
    End With
    
    Cells.Borders.LineStyle = xlNone
    Cells(1, 1).Select


    Feuil1.Activate
    Cells(1, 1).Select
End Sub