Copier des lignes selon critères vers un tableau similaire autre feuille

Bonjour, à toutes et à tous

j'ai une base de données Incidents technique signalé par tierce comme montrer dans mon fichier ci-joint

je doit faire un filtre automatique qui filtre les donnée "En Cours" et "Clôturé" et laisser Afficher que les Incidents "En Cours"

(VBA Excel)

les données "Clôturé" doivent être copié systématiquement de la feuille "Incidents" vers la feuille "Archive" qui contienne un tableau similaire au fur et à mesure ou l'incident est "Clôturé"

merci de votre aide

et j'ai un petit souci dans mon code vba :

Private Sub Worksheet_Change(ByVal target As Range)
If target <> "" And target.Column = 10 Then Call copie(target): Exit Sub
Set isct = Intersect(target, Range("E:E"))
If Not isct Is Nothing Then Call madate(isct)

End Sub
Sub copie(valeur)
Application.EnableEvents = False
If valeur <> "" And valeur.Column = 10 Then
With valeur.Parent.ListObjects("BASE_INCIDENTS")
Set zone = .ListRows(valeur.Row - .HeaderRowRange.Row).Range
End With
With Sheets("Archive").ListObjects("Archive")
Set l = .ListRows.Add
zone.Copy l.Range
End With
zone.Delete
End If
Application.EnableEvents = True
End Sub

Sub madate(isct)

Application.EnableEvents = False
For Each d In isct.Cells
If IsEmpty(d) Then
d.Offset(0, -3) = ""
Else
d.Offset(0, -3) = Format(Now, "mm/dd/yy")
End If
Next
For Each h In isct.Cells
If IsEmpty(h) Then
h.Offset(0, -2) = ""
Else
h.Offset(0, -2) = Format(Now, "hh:mm:ss")
End If
Next
Application.EnableEvents = True
End Sub

Private Sub Workbook_Sheetchange(ByVal Sh As Object, ByVal target As Range)

ActiveWorkbook.Save

End Sub

Function LastAuthor()
LastAuthor = ActiveWorkbook.BuiltinDocumentProperties("Last Author")
End Function
Rechercher des sujets similaires à "copier lignes criteres tableau similaire feuille"