XL 2016 Copier certaines cellules de plusieurs ou d'une ligne(s) d'un tableau sur autre feuille

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [C9]) Is Nothing Then
         Application.ScreenUpdating = False
         Application.EnableEvents = False
         Dim T, i%, Ligne%
         [B16:F1000].ClearContents
         With Sheets("ORDERS")
            DL = .[A65500].End(xlUp).Row
            T = .Range("A1:G" & DL)
            Ligne = 16
            For i = 2 To UBound(T)
                If T(i, 2) = Val(Target) Then
                    Cells(Ligne, "B") = T(i, 1) 'Code
                    Cells(Ligne, "C") = T(i, 4) 'Product
                    Cells(Ligne, "D") = T(i, 7) 'Price
                    Cells(Ligne, "E") = T(i, 5) 'Number
                    Cells(Ligne, "F") = T(i, 6) 'Total
                    Ligne = Ligne + 1
                End If
            Next i
         End With
    End If
Fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Application.EnableEvents = False

Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [H9]) Is Nothing Then Exit Sub
Dim titre As Range, mem, critere As Range
Application.ScreenUpdating = False
Set titre = [B15:F15]
mem = titre 'mémorise'
titre = Array("ID", "PRODUCTS", "BENEFIT", "QUANTITY", "TOTAL") 'on a de la suite dans les idées
titre.Offset(1).Resize(Rows.Count - titre.Row).Delete xlUp 'RAZ
With Sheets("ORDERS").[A1].CurrentRegion
    Set critere = .Cells(1, .Columns.Count + 2).Resize(2)
    critere(1) = "ORDER ID"
    critere(2) = [H9]
    .AdvancedFilter xlFilterCopy, critere, titre 'filtre avancé copié
End With
critere = "" 'RAZ
titre = mem 'restitution
titre.CurrentRegion.BorderAround Weight:=xlMedium 'bordures
End Sub