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

[Eleutheros]

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

 

[natorp]

Bjr Eleutheros

Si j'ai compris et simplifié :
Si une durée en entrée en colonne K la ligne concernée bascule directement dans l'archive ? oui ?

Cordialement, Gérard

 

[sousou]

Je te proposes ceci
si la date de fin est non nul alors on copie l'incident dans la feuille archive
et on supprimmede la feuille incident
A voir si c'est la méthode recherchée
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target <> "" And Target.Column = 10 Then
With Target.Parent.ListObjects("BASE_INCIDENTS")
Set zone = .ListRows(Target.Row - .HeaderRowRange.Row).Range
End With
With Sheets("Archive").ListObjects("Tableau2")
Set l = .ListRows.Add
zone.Copy l.Range
End With
zone.Delete
End If
Application.EnableEvents = True
End Sub

 

[Eleutheros]

Bjr Eleutheros

Si j'ai compris et simplifié :
Si une durée en entrée en colonne K la ligne concernée bascule directement dans l'archive ? oui ?

Cordialement,

Bonjour Gérard

oui c'est bien ça

 

[Eleutheros]

Je te proposes ceci
si la date de fin est non nul alors on copie l'incident dans la feuille archive
et on supprimmede la feuille incident
A voir si c'est la méthode recherchée
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target <> "" And Target.Column = 10 Then
With Target.Parent.ListObjects("BASE_INCIDENTS")
Set zone = .ListRows(Target.Row - .HeaderRowRange.Row).Range
End With
With Sheets("Archive").ListObjects("Tableau2")
Set l = .ListRows.Add
zone.Copy l.Range
End With
zone.Delete
End If
Application.EnableEvents = True
End Sub

Merci Beaucoup sousou ça fonctionne à merveille

 

[Eleutheros]

Je te proposes ceci
si la date de fin est non nul alors on copie l'incident dans la feuille archive
et on supprimmede la feuille incident
A voir si c'est la méthode recherchée
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target <> "" And Target.Column = 10 Then
With Target.Parent.ListObjects("BASE_INCIDENTS")
Set zone = .ListRows(Target.Row - .HeaderRowRange.Row).Range
End With
With Sheets("Archive").ListObjects("Tableau2")
Set l = .ListRows.Add
zone.Copy l.Range
End With
zone.Delete
End If
Application.EnableEvents = True
End Sub

Re-Bonjour sousou
j'ai ce code qui bug avec celui de l'archivage
Private Sub Worksheet_Change(ByVal Target As Range)
Dim d, h, iSct As Range
Set iSct = Intersect(Target, Range("E:E"))
If iSct Is Nothing Then Exit Sub
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

care celui ci est pour la date et l'heure de la saisie des incidents dans le tableau , puisque cette date me permet de comparaitre entre les dates (date de saisie et celle de l'incident) genre de contrôle
et "Private Sub Worksheet_Change(ByVal Target As Range)" la même que le code de l'archive
puisque ci je saisie dans la 4éme colonne la date se met automatiquement

et j'arrive pas à jumeler les deux code ensemble

et j'essaie de désactiver celui de la date j'ai eu ça

merci d'avance

 

[sousou]

Essai comme ceci
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("Tableau2")
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

 

[Eleutheros]

Essai comme ceci
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("Tableau2")
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

Bonjour,
J'ai bug lors de la saisie dans n'importe quelle cellule
En plus la date est liée à la colonne E en premier puis il viendra exécution de celui de l'archive

 

[sousou]

bonjour.
je ne vois pas le problème chez moi.
peux-tu envoyer le fichier?

 

[Eleutheros]

bonjour.
je ne vois pas le problème chez moi.
peux-tu envoyer le fichier?

Bonjour, j'apprécier vraiment votre aide, merci pour votre effort
Voici le fichier en piece jointe
capture écran de l'erreur que j'ai eu

 

[sousou]

Re
A tester.:
Tu utilises options explicit! donc toutes les variables doivent être déclarée en amont.
J'ai donc ajouter les variables qui concernent ma partie.
Ton tableau(feuille archive) s'appelait à l'origniene tableau2 , maintenant il s'appelle Archive, j'ai modifié dans le code
A suivre