Exporter des données filtrées

[vinz115]

Bonjour,

J'aimerais de façon automatisée (sous l'action d'une macro), prendre des données suivant un critere et l'exporté vers une autre feuille déjà existante.

Dans l'exemple ci joint, sous l'action de la macro que les données passe de "Data" vers "DataSort" avec comme critére temps > 30 .

J'ai bien essayé avec un filtre mais les critéres sautent quand il n'y a pas de données dans la feuille.

Déjà merci pour l'aide

Vincent

 

[Modeste geedee]

Re : Exporter des données filtrées

Bonsour®

obtenu via l'enregistreur et aprés quelques élagages :

Sub Macro1()
    ' ----- efface la zone reception
     Sheets("DataSort").Range("A1").CurrentRegion.ClearContents
    '----- mise en place filtre
    Sheets("Data").Select
    ActiveSheet.Range("$A$1:$C$6").AutoFilter Field:=3, Criteria1:=">=30", _
        Operator:=xlAnd
    '-----     récuperation zone filtrée
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    '------  mise place copie
    Sheets("DataSort").Select
    Range("A1").Select
    ActiveSheet.Paste
    ' -------- restoration  conditions initiales
    Sheets("Data").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
End Sub

 

[vinz115]

Re : Exporter des données filtrées

Super !

Un grand merci.

J'ai juste du rajouté une ligne en début de feuille, sinon elle échappait au filtre.

Ce qui donne:

Sub MakeData10()

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Sheets("Data").Select
        Rows("1:1").Select
       Selection.Insert Shift:=xlDown


    'efface la zone reception
     Sheets("Data10").Range("A1").CurrentRegion.ClearContents
    
    'mise en place filtre
    Sheets("Data").Select
    ActiveSheet.Range("$A$1:$N$3001").AutoFilter Field:=7, Criteria1:=">=601", 
_Operator:=xlAnd
    
    'récuperation zone filtrée
    Range("A1:N3001").Select
    Selection.Copy
    
    'mise place copie
    Sheets("Data10").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    'restoration  conditions initiales
    Sheets("Data").Select
    Application.CutCopyMode = False
    Selection.AutoFilter

   
    Sheets("Rapport1").Select
    
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

Vincent