Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Dim dest As Range, source As Range, r As Range, h&
'---initialisation---
Set dest = [C2] '1ère cellule, à adapter
With Feuil1 'CodeName
Set source = .[E:F] 'colonnes à adapter
Set source = Intersect(source, .UsedRange.EntireRow)
End With
'---copie---
Application.ScreenUpdating = False
source.Copy dest 'pour les formats
Set dest = dest.Resize(source.Rows.Count, source.Columns.Count)
dest = source.Value 'copie les valeurs
'---traitement des données---
On Error Resume Next 's'il n'y a pas de SpecialCells
dest.Replace [A1], "#N/A", xlWhole
With dest.SpecialCells(xlCellTypeConstants, 16)
.Clear
With Intersect(.EntireRow, dest)
h = Intersect(.Cells, dest.Columns(1)).Count
.Copy dest(dest.Rows.Count + 1, 1) 'zone tampon sous le tableau
End With
End With
dest.Offset(dest.Rows.Count).Resize(h).Copy dest(1)
dest.Offset(h).Resize(Rows.Count - h - dest.Row + 1).Delete xlUp
End Sub