Private Sub Worksheet_Activate()
Dim source As Range, dest As Range, coul
Set source = Feuil1.[A4:A100] 'CodeName de la feuille
Set dest = [A7]
coul = RGB(255, 0, 0) 'rouge
Application.ScreenUpdating = False
dest.Resize(Rows.Count - dest.Row + 1).Clear 'RAZ
source(, 2).EntireColumn.Insert 'colonne auxiliaire, les formats sont copiés
With source.Columns(2)
.Value = source.Value 'copie les valeurs
.AutoFilter 1, coul, xlFilterFontColor 'filtre automatique
.SpecialCells(xlCellTypeVisible).Copy dest
.EntireColumn.Delete
End With
End Sub