XL 2013 Worksheet_change copier/coller sur un autre classeur

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim CS As Workbook
  Dim WS As Worksheet
  Dim CD As Workbook
  Dim OD As Worksheet
  Dim LI As Integer
  Dim PV As Integer
  Dim R As Range
  Dim TD As ListObject
 
  If Not Intersect(Target, Range("E15:F100")) Is Nothing Then Exit Sub
  Application.ScreenUpdating = False
  CA = "T:\UAP EMO:\Qualite\13-Audits Internes\2022\"
  Set CS = ThisWorkbook
  Set WS = CS.Worksheets("audit")
 
 
  If Target.Count > 2 Then Exit Sub
  If Target.Row < 15 Then Exit Sub
  If Target.Column < 5 Or Target.Column > 6 Then Exit Sub
Application.EnableEvents = False

If Target.Value <> 0 Then
On Error Resume Next
            Set CD = Workbooks("PDCA -Audits Coordinateurs Qualité V2022")
            If Err <> 0 Then
                Err.Clear
                Set CD = Application.Workbooks.Open(CA & "PDCA -Audits Coordinateurs Qualité V2022")
            End If
            On Error GoTo 0
            Set OD = CD.Worksheets("PDCA")
            Set TD = OD.ListObjects("PDCA")
            Set R = TD.ListColumns(1).Range.Find("")
            If R Is Nothing Or TD.ListRows.Count = 0 Then
                TD.ListRows.Add
                PV = TD.ListRows.Count
            Else
                PV = R.Row - TD.HeaderRowRange.Row
            End If

  TD.DataBodyRange(PV, 1).Value = ActiveSheet.Range("A" & Target.Row).Value
  TD.DataBodyRange(PV, 13).Value = Cells(Target.Row, 4).Value 'Delai
  TD.DataBodyRange(PV, 12).Value = Cells(Target.Row, 3).Value 'Pilote
  TD.DataBodyRange(PV, 10).Value = Cells(Target.Row, 5).Value 'Action
  TD.DataBodyRange(PV, 6).Value = Cells(13, 2).Value  'installation
  TD.DataBodyRange(PV, 7).Value = Cells(14, 2).Value  ' Référence
  TD.DataBodyRange(PV, 1).Value = Cells(5, 2).Value 'Date en semaine si possible
 Application.EnableEvents = True
 End If
End If
 
End Sub