Erreur 1004 pas de cellules correspondantes

Bonsoir le forum,

Je souhaite avoir un coup de main sur une macro, qui a pour but de trier des données en fonction d'un critère et d'aller les coller dans un autre tableau. mais depuis que j'ai rajouté quelques lignes, la macro ne fonctionne plus et m'affiche le code erreur 1004 :

la macro :

Sub CopieFiltre()

    Dim Plage As Range

    With Worksheets("LISTING")

        Set Plage = .Range(.Cells(21, 1), .Cells(Rows.Count, 5).End(xlUp)) 'le tableau "LISTE"

        Plage.AutoFilter 2, "=AIDE"

        Plage.Columns("A:A").Cells.SpecialCells(xlCellTypeVisible).Copy Worksheets("CATEGORIE").Cells(13, 1)

        'comme dans la copie d'un filtre la ligne d'entête est automatiquement embarquée, suppression
        Worksheets("CATEGORIE").Rows(13).Delete

        Plage.AutoFilter

    End With

End Sub

La ligne qui pose problème :

Plage.Columns("A:A").Cells.SpecialCells(xlCellTypeVisible).Copy Worksheets("CATEGORIE").Cells(13, 1)

le fichier source :

Merci d'avance le forum !

Bonjour quentinmgt,

à tester,

Sub transfert()
Dim lignes_visibles  As Range
With Worksheets("LISTING").ListObjects(1)
        Set objListRng = .HeaderRowRange
        objListRng.AutoFilter 2, "=AIDE"
        Set lignes_visibles = .DataBodyRange.SpecialCells(xlCellTypeVisible)
        lignes_visibles.Copy Worksheets("CATEGORIE").Cells(13, 1)
 End With
End Sub

Bonsoir i20100,

merci pour la réponse.

Donc le tri à fonctionné, la copie fonctionne mais elle copie le tableau entier au lieu de simplement les données de la colonne description, ensuite le tableau ne se "re-filtre" plus

re,

oups, voici pour la colonne A

Sub transfert()
Dim lignes_visibles  As Range
With Worksheets("LISTING").ListObjects(1)
        Set objListRng = .HeaderRowRange
        objListRng.AutoFilter 2, "=AIDE"
        objListRng.Copy Sheets("Feuil1").[A1]
        Set lignes_visibles = .DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible)
        lignes_visibles.Copy Worksheets("CATEGORIE").Cells(13, 1)
 End With
 objListRng.AutoFilter
 objListRng.AutoFilter
End Sub

faut il faire une boucle pour les autre colonnes ?

J'ai une erreur sur la ligne :

objListRng.Copy Sheets("Feuil1").[A1]

surement dû au fait que je n'ai pas de feuille nommée Feuil1 ?

Et si c'est possible pour tout les critères oui pourquoi pas !

merci beaucoup pour votre aide !

En essayant de créer la feuil1 la macro à fonctionne parfaitement !

Elle envoi les entête dans la feuil1!

J'ai donc redirigé l'ordre sur les entêtes du tableau LISTE comme ceci :

objListRng.Copy Sheets("LISTING").[A1]

voici la correction,

Sub transfert()
Dim lignes_visibles  As Range
With Worksheets("LISTING").ListObjects(1)
        Set objListRng = .HeaderRowRange
        objListRng.AutoFilter 2, "=AIDE"
        Set lignes_visibles = .DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible)
        lignes_visibles.Copy Worksheets("CATEGORIE").Cells(13, 1)
 End With
 objListRng.AutoFilter
 objListRng.AutoFilter
End Sub

Effectivement la correction fonctionne, merci!

Comment puis-je créer les boucles afin de donner l'ordre de copie en fonction de chaque critère ?

Le but est de copier ces donnée sur la deuxième ligne de chaque colonne de la feuille "CATEGORIE" en fonction des noms des colonnes les données correspondantes à la catégorie dans le tableau "LISTE"

re,

voici le code au complet,

Sub transfert()
Dim lignes_visibles  As Range
With Worksheets("LISTING").ListObjects(1)
        Set objListRng1 = Worksheets("LISTING").ListObjects(1).HeaderRowRange
End With

With Worksheets("CATEGORIE").ListObjects(1)
        Set objListRng2 = .HeaderRowRange

        For i = 1 To objListRng2.Count
            m = objListRng2.Cells(1, i)
            objListRng1.AutoFilter 2, "=" & m
            If Not IsError(Application.Match(m, Worksheets("LISTING").Columns(2), 0)) Then
                Set lignes_visibles = Worksheets("LISTING").ListObjects(1).DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible)
                lignes_visibles.Copy Worksheets("CATEGORIE").Cells(13, i)
                objListRng1.AutoFilter
                objListRng1.AutoFilter
            End If
        Next i
End With
End Sub

Bonjour I20100,

Merci beaucoup, la macro fonctionne à merveille!