Copier Coller apres un filtre

Bonsoir a tous,

J'aurais besoin de votre expertise en excel afin de m'aider sur le sujet suivant:

alors voila j'ai une macro qui me permet de faire un filtre puis supprimer les doublons jusque la cela fonctionne tres bien ,

Par contre je souhaiterai copier les donnees filtrer en colonne A Puis coller sur un autre classeurs d'un onglet

Merci de votre Aide.

Sub Copie()

'Range(Selection, Selection.End(xlDown)).Select

    Columns("A:A").Select
    ActiveSheet.range("$A$1:$E$700000").RemoveDuplicates Columns:=1, Header:= _
        xlYes
    Selection.NumberFormat = "0.00"
    Selection.NumberFormat = "0.0"
    Selection.NumberFormat = "0"
    Selection.Replace What:="'", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveSheet.range("$A$1:$E$700000").AutoFilter Field:=2, Criteria1:="OL"

End Sub

Bonjour,

Testes si ça convient. Ici, la copie est faite sur la feuille "Feuil2" du même classeur à partir de A1 (la feuille active ne doit pas être la feuille "Feuil2") :

ActiveSheet.AutoFilter.Range.EntireRow.Copy Worksheets("Feuil2").Cells(1, 1)

Bonjour,

Une proposition à étudier.

J'ai considéré qu'il n' avait pas de lignes vides.

Après filtre, on copie les données de la colonne 1 (A) dans une nouvelle feuille.

Il serait judicieux de mettre les données sous forme de tableau.

As-tu réellement 700.000 lignes ?

Peux-tu joindre un fichier représentatif de tes données (une centaine de lignes, données anonymisées si nécessaire)

A te relire.

Cdlt.

Public Sub Copy_data()
Dim ws As Worksheet, Rng As Range, n As Long
    With ActiveSheet
        If .FilterMode Then .ShowAllData
        With .Cells(1).CurrentRegion
            .RemoveDuplicates 1, xlYes
            .AutoFilter 2, "LO"
        End With
        Set Rng = .AutoFilter.Range.Columns(1)
        n = Rng.SpecialCells(12).Rows.Count - 1
        If n = 0 Then
            MsgBox "Aucune donnée à copier !..."
        Else
            Set ws = Worksheets.Add
            Rng.SpecialCells(12).Copy ws.Cells(1)
        End If
        .Range("A1").AutoFilter 2
    End With
End Sub

Bonjour a Tous

Je vous remercie C'est SUPER je l'ai adapter a mon fichier et tout fonctionne a merveille.

Encore Merci

Rechercher des sujets similaires à "copier coller filtre"