Copier automatiquement d'un classeur vers un autre avec CONDITIO

Option Explicit
Public Sub Lancer()
Dim nom As String
    nom = InputBox("Indiquer le nom de la catégorie à transférer")
    If nom <> "" Then Call copie(nom)
End Sub
Public Sub copie(nom)
Const ndf = "ANNEE 2017"    'nom de la feuille à copier
Dim cla As Workbook, feu As Worksheet, ws As Worksheet
Dim lig As Long, nbs As Long, cls As Long
    For Each cla In Workbooks   ' recherche classeur
        If cla.Name <> ThisWorkbook.Name Then
            For Each feu In cla.Sheets   ' recherche feuille
                If feu.Name = "DEPENSE" Then
                        Set ws = Workbooks(cla.Name).Sheets(feu.Name)
                        With ThisWorkbook.Sheets(ndf)   ' recherche noms présents
                            If Application.CountIf(ws.Columns(4), nom) > 0 Then
                                MsgBox "présence du nom choisi dans DEPENSE"
                            End If
                            lig = ws.Range("Tableau1[Colonne1]").Find("").Row
                            .Range("$A$3:$J$" & .UsedRange.Rows.Count).AutoFilter Field:=4, Criteria1:=nom
                            nbs = .Range("D3:D" & .Cells(Rows.Count, "D").End(xlUp).Row).SpecialCells(xlVisible).Count
                            If .Cells(Rows.Count, "D").End(xlUp).Row > 2 Then ' copie éléments sélectionnés
                                For cls = nbs To 1 Step -1
                                    ws.Cells(lig, "A").ListObject.ListRows.Add AlwaysInsert:=False
                                Next cls
                                .Range("B3:I" & .UsedRange.Rows.Count).SpecialCells(xlVisible).Copy
                                ws.Cells(lig, "A").PasteSpecial xlPasteValues
                                .Range("J3:J" & .UsedRange.Rows.Count).SpecialCells(xlVisible).Copy
                                ws.Cells(lig, "J").PasteSpecial xlPasteValues
                                MsgBox nbs & " lignes copiées"
                            Else
                                MsgBox "Pas de lignes à copier"
                            End If
                            .Range("$A$3:$J$" & .UsedRange.Rows.Count).AutoFilter Field:=4
                        End With
                End If
            Next feu
        End If
    Next cla
    If ws Is Nothing Then MsgBox "pas de feuille DEPENSE ouverte"
End Sub