Bonjour à tous,
Désolé pour ma réponse tardive, voici ce que j'ai intégré pour que cela fonctionne :
Option Explicit
Sub micro()
Call ActiverDésactiverEvenement(False)
Dim lo As ListObject, lo2 As ListObject
Dim feuildetravail As Worksheet, feuildedonnées As Worksheet
Dim Cell As Range, rCell As Range
Dim lRow As Long
With ThisWorkbook
Set feuildedonnées = Worksheets("affaires") 'renommer les feuilles ICI
Set feuildetravail = Worksheets("+3mois") 'renommer les feuilles ICI
Set lo = feuildedonnées.ListObjects(1)
Set lo2 = feuildetravail.ListObjects(1)
End With
With feuildedonnées
.Activate
.Cells(1).Select
End With
Call DeleteListRow(lo2)
For Each Cell In lo.ListColumns(19).DataBodyRange
If Not IsEmpty(Cell) And IsDate(Cell) Then
If VBA.Date - Cell.Value > 90 Then
Select Case Cell.Offset(, -15)
Case "En cours", "Shooté":
With lo2
If .InsertRowRange Is Nothing Then
Set rCell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
Else
Set rCell = .InsertRowRange.Cells(1)
End If
End With
lRow = Cell.Row - lo.HeaderRowRange.Row
lo.ListRows(lRow).Range.Copy
rCell.PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Case Else
End Select
End If
End If
Next Cell
With feuildetravail
.Activate
.Cells(1).Select
End With
Call ActiverDésactiverEvenement(True)
End Sub
Sub DeleteListRow(lo2)
Dim iRowNumber As Integer
Dim objListRows As ListRows
Set objListRows = lo2.ListRows
For iRowNumber = objListRows.Count To 1 Step -1
objListRows(iRowNumber).Delete
Next iRowNumber
End Sub
Public Sub ActiverDésactiverEvenement(Vérité As Boolean) '-
Application.EnableEvents = Vérité '-
Application.ScreenUpdating = Vérité '-
End Sub