Fusionner 2 codes VBA

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1,I1]) Is Nothing Then Exit Sub
Dim dest As Range, source As Range, h&
'---initialisation---
Set dest = [K2] '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
dest.Replace [I1], "#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

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, dest As Range, source As Range, h&
Set r = [A1,E1,I1] 'plage à adapter
If Intersect(Target, r) Is Nothing Then Exit Sub
'---initialisation---
Set dest = [K2] '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
For Each r In r
  dest.Replace r, "#N/A", xlWhole
Next
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

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, source As Range, dest As Range, h&
Set r = Intersect(Target, [A1,I1]) 'plage à adapter
If r Is Nothing Then Exit Sub
'---initialisation---
With Feuil1 'CodeName
  Set source = .[E:F] 'colonnes à adapter
  Set source = Intersect(source, .UsedRange.EntireRow)
End With
Application.ScreenUpdating = False
On Error Resume Next 's'il n'y a pas de SpecialCells
For Each r In r 'si entrées multiples
  Set dest = r(2, 3) '1ère cellule, décalages à adapter
  '---copie---
  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---
  dest.Replace r, "#N/A", xlWhole
  With dest.SpecialCells(xlCellTypeConstants, 16)
    .Clear
    With Intersect(.EntireRow, dest)
      h = 0
      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
Next
End Sub