Discussion :

[damandjy]

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 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
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

Classeur_Incidents.xlsm

[EricDgn]

Bonjour,

Une façon de faire agissant sur clic de boutons:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Option Explicit
 
Sub ArchiverClotures()      '--- archiver incidents marqués "clôturés"
    Dim loBase As ListObject, loArch As ListObject, rBase As Range
    Set loBase = ActiveSheet.ListObjects("BASE_INCIDENTS")
    Set loArch = Worksheets("Archive").ListObjects("Archive")
    loBase.Range.AutoFilter Field:=14, Criteria1:="Clôturé"
    If loBase.Range.SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then
        '--- aucun incident clôturé à archiver --- passer
    Else
        '--- copier-coller incidents clôturés
        loBase.DataBodyRange.SpecialCells(xlCellTypeVisible).Cut
        Sheets("Archive").Select
        loArch.DataBodyRange(loArch.ListRows.Count, 1).Offset(1, 0).Select
        ActiveSheet.Paste
        '--- supprimer lignes incidents clôturés archivés
        Sheets("Incident").Select
        Range("BASE_INCIDENTS[Num-Auto]").Select
        Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If
    loBase.Range.AutoFilter '--- réafficher tout
    Range("A8").Select
    Set loBase = Nothing
    Set loArch = Nothing
End Sub
 
Sub AjoutIncident()
    Dim loBase As ListObject
    Set loBase = ActiveSheet.ListObjects("BASE_INCIDENTS")
    loBase.ListRows.Add
    loBase.DataBodyRange.Cells(loBase.ListRows.Count, 1).Select
    '--- enregistre code dernier incident en A1
    '--- nécessaire pour incrémenter l'incident suivant, le dernier étant peut-être déjà archivé
    Range("A1") = Format(CLng(Left(Range("A1"), 6)) + 1, "000000") & Right(Range("A1"), 5)
    '--- préremplissage
    ActiveCell = Range("A1")
    ActiveCell.Offset(0, 1) = Date
    ActiveCell.Offset(0, 2) = Format(Now, "hh:nn:ss")
    ActiveCell.Offset(0, 3) = ActiveWorkbook.BuiltinDocumentProperties("Last Author")
    ActiveCell.Offset(0, 4).Select
    Set loBase = Nothing
End Sub

Cordialement.