XL 2013 Copie vers un autre classeur avec condition

[Dafaka7]

Bonjour le forum,

J'ai essayé une macro Worksheet_change pour copier vers un autre classeur selon la condition colonne 14 = 4,
Mais la macro ne fonctionne pas.
Il faudrait que lorsque dans la colonne 14 on met le chiffre 4, alors la ligne est copié/collé sur le tableau du second fichier dans la feuille "plan d'action niveau 2" sur la derniere ligne du tableau

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("N6:N1000")) Is Nothing Then
  Application.ScreenUpdating = False
  CA = "T:\UAP EMBOUT"
  Set CS = ThisWorkbook
  Set WS = CS.Worksheets("PDCA")
 
 
  If Target.Count > 1 Then Exit Sub
  If Target.Row < 6 Then Exit Sub
  If Target.Value < 4 Or Target.Value > 4 Then Exit Sub
  If Target.Column < 14 Or Target.Column > 14 Then Exit Sub
Application.EnableEvents = False
If Target.Value = 4 Then
On Error Resume Next
            Set CD = Workbooks("Format réunion GT 2022 V2.xlsm")
            If Err <> 0 Then
                Err.Clear
                Set CD = Application.Workbooks.Open(CA & "Format réunion GT 2022 V2.xlsm")
            End If
            On Error GoTo 0
            Set OD = CD.Worksheets("Plan d'action niveau 2")
            Set TD = OD.ListObjects("niveau2")
            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

  TD.DataBodyRange(PV, 1).Value = ActiveSheet.Range("A" & Target.Row).Value
  TD.DataBodyRange(PV, 1).Value = Cells(Target.Row, 1).Value
  TD.DataBodyRange(PV, 2).Value = Cells(Target.Row, 2).Value
  TD.DataBodyRange(PV, 3).Value = Cells(Target.Row, 3).Value
  TD.DataBodyRange(PV, 4).Value = Cells(Target.Row, 4).Value
  TD.DataBodyRange(PV, 5).Value = Cells(Target.Row, 5).Value
  TD.DataBodyRange(PV, 6).Value = Cells(Target.Row, 6).Value
  TD.DataBodyRange(PV, 7).Value = Cells(Target.Row, 7).Value
  TD.DataBodyRange(PV, 8).Value = Cells(Target.Row, 8).Value
  TD.DataBodyRange(PV, 9).Value = Cells(Target.Row, 9).Value
  TD.DataBodyRange(PV, 10).Value = Cells(Target.Row, 10).Value

 Application.EnableEvents = True
 End If
 End If
End Sub

 

[fanch55]

bonjour,

 CA = "T:\UAP EMBOUT\"

Pourquoi cela, c'est la même chose ... :

  TD.DataBodyRange(PV, 1).Value = ActiveSheet.Range("A" & Target.Row).Value
  TD.DataBodyRange(PV, 1).Value = Cells(Target.Row, 1).Value

 

[Dafaka7]

Bonjour @fanch55 ,

Je me suis inspiré d'ancienne macro faites sur le premier fichier.
En effet c'était juste le \ le problème