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

Eleutheros

XLDnaute Nouveau
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
 

Pièces jointes

  • Classeur_Incidents.xlsx
    28.9 KB · Affichages: 9
Dernière édition:

sousou

XLDnaute Barbatruc
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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
1644413091299.png

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

1644413256129.png

merci d'avance
 
Dernière édition:

sousou

XLDnaute Barbatruc
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

XLDnaute Nouveau
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
1644747465429.png
 

sousou

XLDnaute Barbatruc
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
 

Pièces jointes

  • Copie de Checklist Incident 2022 - V-04 (test_1).xlsm
    381.4 KB · Affichages: 7

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 838
dernier inscrit
Christelle.B86