Archivage automatique selon des valeures textes

[BADRAYOB]

salut .. Mes amis
lorsque je taper les deux oui - oui je voudrais que le line courant se archivée dans un autre fichier excel de sauvegarde
et aussi avec les autre
le fichier ci joint est mon projet
merciii bien mes amis

 

[JCGL]

Re : Archivage automatique selon des valeures textes

Bonjour à tous,

Bienvenue sur XLD

Un essai avec ce que j'ai compris

A+ à tous

 

[BADRAYOB]

Re : Archivage automatique selon des valeures textes

super+
je suis très fière de vous connaitre

 

[BADRAYOB]

Re : Archivage automatique selon des valeures textes

salue
pardon
j'ai été obliger de modifier qqc dans le macro
par ce que il y a un changement dans le fichier data
alors le problème c a propos des chèques je suis besoin seulement de accomplir la Line pour lui sauvegarder
par contre les facture je doit réaliser le condition de oui-oui au niveau de compté et délivré


donc les chèques >> condition de accomplir
les factures >> condition de oui - oui
j'ai régler le condition des facture mais il y a un problème au niveau de feuille sauvegarde .. essai-vous de faire oui - oui puis exécuter le macro pour voire le problème

 

[JCGL]

Re : Archivage automatique selon des valeures textes

Bonjour à tous,

Peux-tu essayer :

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

A+ à tous

 

[BADRAYOB]

Re : Archivage automatique selon des valeures textes

je suis très fier
merci bien monsieur
je vais vous infirmer par touts nouveauté dans cette discussion