Private Sub Workbook_Open()
On Error GoTo msgerror 'en cas d'erreur
'déclaration des variables
Dim dl As Long, lig As Long, i As Long, sh As Integer, x As Byte
lig = Sheets("Périmé").Range("A" & Rows.Count).End(xlUp).Row + 1
'efface les données de la feuille perimé
Sheets("Périmé").Range("A2:G" & lig).ClearContents
'boucle sur toutes les feuilles
For sh = 1 To Sheets.Count
If Sheets(sh).Name <> "Liste" And Sheets(sh).Name <> "Périmé" Then
'dernière ligne de la feuille en cours de traitement
dl = Sheets(sh).Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To dl ' boucle toutes les lignes de la feuille en cours
If Len(Sheets(sh).Range("D" & i).Value) > 0 Then 'si pas de date
If IsDate(Sheets(sh).Range("D" & i).Value) Then
If Sheets(sh).Range("D" & i).Value - Now < 6 Then 'contrôle si moins de 6 j
'dernière ligne +1 de la feuille périmé
lig = Sheets("Périmé").Range("A" & Rows.Count).End(xlUp).Row + 1
For x = 1 To 6 'boucle sur les colonnes
Sheets("Périmé").Cells(lig, x).Value = Sheets(sh).Cells(i, x).Value
Next x
'ajoute une formule dans la colonne H pour avoir le nb de jours
Sheets("Périmé").Cells(lig, 7).Formula = "=RC[-3]-TODAY()"
End If
End If
End If
Next i
End If
Next sh
Exit Sub
msgerror:
MsgBox ("Erreur ligne" & Erl())
End Sub