Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Tableau()
With Sheets("Base")
NbrLign = .Range("F" & Application.Rows.Count).End(xlUp).Row
ReDim Tableau(1 To NbrLign, 1 To 5)
k = 1
For i = NbrLign To 2 Step -1
If .Cells(i, 6) < Date Then
Tableau(k, 5) = .Cells(i, 6).Value
For j = 1 To 4
Tableau(k, j) = .Cells(i, j).Value
Next j
k = k + 1
.Cells(i, 6).EntireRow.Delete
End If
Next i
End With
With Sheets("Relances")
.Range("A2:E" & .Range("A" & Application.Rows.Count).End(xlUp).Row + 1).ClearContents
.Range("A2").Resize(UBound(Tableau, 1), 5) = Tableau
.Activate
End With
Application.ScreenUpdating = True
End Sub