XL 2013 Copier/coller vers d'autre classeur

Set R = TD.DataBodyRange.Column(3).Find("")

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)

Set TS = Me.ListObjects("Tab_PDCA") 'définit le tableau structuré TS
'si le changement a lieu ailleurs que dans la dernière ligne de TS et la colonne 5, sort de la procédure
If Application.Intersect(Target, TS.DataBodyRange(TS.ListRows.Count, 5)) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub 'si la cible est effacée, sort de la procédure
Module2.qualité 'lance la procédure [qualité] du module [Module2]
End Sub

Sub qualité()
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CS As Workbook 'définit la variable CS (classeur Source)
Dim OS As Worksheet 'définit la variable OS (Onglet Source)
Dim TS As ListObject 'définit la variable TS (Tableau Source)
Dim LI As Integer 'définit la variable LI (Ligne)
Dim CD As Workbook 'définit la variable CD (Classeur Destination)
Dim OD As Worksheet 'définit la variable OD (Onglet Destination)
Dim TD As ListObject 'définit la variable RD (Tableau Destination)
Dim R As Range 'définit la variable R (Recherche)
Dim PV As Integer 'définit la variable PV (Première ligne Vide)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
CA = "T:\UAP EMBOUT\PDCA\"
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Récupération") 'définit l'onglet source OS
Set TS = OS.ListObjects("Tab_PDCA") 'définit le tableau structuré source
LI = TS.ListRows.Count 'définit la ligne LI

'service Qualité
If TS.DataBodyRange(LI, 5).Value = "Qualité" Then 'condition 1 : si le service est "Qualité"
    On Error Resume Next 'gestion des erreur (en cas dérreur passe à la ligne suivante)
    Set CD = Workbooks("PDCA UAP QUALITE.xlsm") 'définit le classeur destination CQ (génère une erreur si le classeur n'est pas ouvert)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        Set CD = Application.Workbooks.Open(CA & "PDCA UAP QUALITE.xlsm") 'définit le classeur destination CQ en l'ouvrant
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    Set OD = CD.Worksheets("Plan d'action") 'définit l'onglet destination OD
    Set TD = OD.ListObjects("T_action3") 'définit le tableau structuré destinatkion TD
    'ajout des valeurs dans TD
    Set R = TD.ListColumns(3).Range.Find("")  'définit la recherche R (recherche du vide dans la colonne 1 de TD)
    If R Is Nothing Or TD.ListRows.Count = 0 Then 'condition 2 : si aucune occurrence n'est trouvée
        TD.ListRows.Add 'ajoute une ligne à TD
        PV = TD.ListRows.Count 'définit la ligne PV (Première ligne Vide de la colonne 3 de TD)
    Else 'sinon (au moins une occurrence est trouvée)
        PV = R.Row - TD.HeaderRowRange.Row 'définit la ligne PV (ligne de la première occurrence trouvée moins la ligne des en-têtes de TD)
    End If 'fin de la condition 2
End If 'fin de la condition 1

'service prodution
If TS.DataBodyRange(LI, 5).Value = "Production" Then
    On Error Resume Next
    Set CD = Workbooks("PDCA Production.xlsm")
    If Err <> 0 Then
        Err.Clear
        Set CD = Application.Workbooks.Open(CA & "PDCA Production.xlsm")
    End If
    On Error GoTo 0
    Set OD = CD.Worksheets("Plan d'action")
    Set TD = OD.ListObjects("T_Prod")
    Set R = TD.ListColumns(3).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
End If

'renvoie les données dans l'auter fichier
TD.DataBodyRange(PV, 1).Value = TS.DataBodyRange(LI, 1).Value
TD.DataBodyRange(PV, 3).Value = TS.DataBodyRange(LI, 2).Value
TD.DataBodyRange(PV, 7).Value = TS.DataBodyRange(LI, 3).Value
TD.DataBodyRange(PV, 10).Value = TS.DataBodyRange(LI, 4).Value
End Sub

 If Not Intersect(Target, [Tab_PDCA]) Is Nothing Then
   tablo = [Liste_Services]
    Abrev = [Abrev]
   If Cells(Target.Row, 1) <> "" And Cells(Target.Row, 6) <> "" Then
       For i = 1 To UBound(tablo)
            If tablo(i, 1) = Cells(Target.Row, 6) Then Abrev = Abrev(i, 1)
        Next i
        Application.EnableEvents = False
        Cells(Target.Row, 2) = Cells(Target.Row, 1) & Abrev
        Application.EnableEvents = True
    End If
End If