Macro copie avec tri sans lignes vides

Bonjour le forum !

Je cherche actuellement un moyen de copier une partie d'un tableau en fonction de la valeur contenue dans une cellule de chaque ligne.

J'ai réussi à trouver comment faire pour coller uniquement les lignes qui contiennent l'information recherchée, mais le tableau de départ se "colle" en entier, avec des lignes vides pour celles qui ne contiennent pas l'information recherchée...

Je vous propose un fichier pour vous présenter mon cas (je n'ai pas fait de bouton pour lancer la macro, elle s'appelle "copie" dans l'onglet développeur --> macro)

Merci d'avance pour votre aide !

Mareelo

bonjour,

une proposition parmi d'autres

Sub test()
With Sheets("Feuil1")
Sheets("Feuil2").Range("A1").CurrentRegion.ClearContents
    .Range("A1:E1").AutoFilter
    .Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:="Entrée"
    .Range("A1").CurrentRegion.Copy Sheets("Feuil2").Range("A1")
    .Range("A1:E1").AutoFilter
End With
End Sub

Bonsoir,

Une autre solution

Option Explicit
Public Sub Filtre_Entrées()
'Ctrl+w pour lancer la procédure
Dim wS1 As Worksheet, wS2 As Worksheet
Dim Plage As Range

    Application.ScreenUpdating = False
    Set wS1 = Worksheets(1)
    Set wS2 = Worksheets(2)

    wS2.Cells.ClearContents

    With wS1
        Set Plage = .[A1].CurrentRegion
        Plage.AutoFilter Field:=2, Criteria1:="Entrée"
        Set Plage = .AutoFilter.Range
        Plage.Copy wS2.[A1]
        Plage.AutoFilter
    End With

    wS2.Activate

    Set wS1 = Nothing: Set wS2 = Nothing: Set Plage = Nothing

End Sub

Cdlt

Bonjour !

Merci pour vos réponses ! Elles fonctionnent toutes les deux dans mon fichier "Test", mais une fois transposées dans mon fichier de travail elles ne fonctionnent plus -_-' Seule la première ligne est transférée dans la feuille 2.

J'ai pourtant changé le nom de mes feuilles et adapté les paramètres ("Entrée" devient "Oui" dans une autre colonne), de la réponse de Game Over, et j'ai juste changé le "Entrée" en "Oui dans la réponse de Jean-Eric (y avait-il autre chose à modifier ? je n'ai pas tout compris à cette proposition:-/)

Par ailleurs, pourquoi faut-il faire ctrl+w pour lancer la macro ? un bouton ne fonctionnerait pas ?

Merci d'avance et bonne journée à vous,

Mareelo

c'est peut-être doute parce que ton fichier original et ton fichier exemple ont des formats différents...

Sans voir ton fichier original, difficile de te répondre.

J'ai pourtant regardé...

Mon fichier de travail n'a rien de bien méchant, je le mets en fichier joint.

(Commencer la semaine par des macros... dur dur ^^)

Mareelo54 a écrit :

J'ai pourtant changé le nom de mes feuilles et adapté les paramètres ("Entrée" devient "Oui" dans une autre colonne)

Le format est donc différent

voici le code adapté à ton fichier original

Sub test()
Dim Dercol As Integer

With Sheets("Tab_gen_AE")
Dercol = .Cells(1, Columns.Count).End(xlToLeft).Column
Sheets("Etude_LR").Range("A1").CurrentRegion.ClearContents
    .Range(.Cells(1, 1), .Cells(1, Dercol)).AutoFilter
    .Range("A1").CurrentRegion.AutoFilter Field:=6, Criteria1:="Oui"
    .Range("A1").CurrentRegion.Copy Sheets("Etude_LR").Range("A1")
    .Range("A1:E1").AutoFilter
End With
End Sub

Yeepee ! Ca fonctionne ! Merci beaucoup !

Maintenant que j'ai "la base" avec ce qu'il faut pour comprendre et bricol... construire le reste de mon outil, je vais pouvoir m'y mettre

Mais n'étant toujours pas forcément douée en vba, je ne mets volontairement pas ce topic comme résolu, des fois que...

Merci encore, et très belle journée à vous !

Re-bonjour,

Je me doutais que je n'irais pas bien loin...

En fait, dans la feuille où je "colle" mon tableau trié, je souhaite mettre des choses à la suite, dans les colonnes qui suivent. Le problème c'est que la macro 'écrase' ce que je prépare vu qu'elle colle l'ensemble du tableau.

Du coup, je pense qu'il faudrait définir une nouvelle zone de sélection à trier et coller (colonnes A à F), mais j'ai beau chercher je n'arrive pas à concilier la sélection et le tri

Je ne pense pas qu'il soit nécessaire de remettre le fichier, je vous redonne la macro telle qu'elle est actuellement.

Sub Tri_aspects_pour_cotation()
Dim Dercol As Integer

With Sheets("Tab_gen_AE")
Dercol = .Cells(1, Columns.Count).End(xlToLeft).Column
Sheets("Etude_agences").Range("A2").CurrentRegion.ClearContents
    .Range(.Cells(1, 1), .Cells(1, Dercol)).AutoFilter
    .Range("A2").CurrentRegion.AutoFilter Field:=6, Criteria1:="Oui" 'dans la sélection qui va de
    .Range("A2").CurrentRegion.Copy Sheets("Etude_agences").Range("A1")
    .Range("A2:E2").AutoFilter
End With

End Sub

Merci d'avance,

Cdt

Le code, on l'a 2 messages plus haut,

ce qu'il faut, c'est un exemple de la feuille cible ("Etude_agences") avec les infos qui sont présentes avant la copie, ainsi que l'emplacement où tu souhaiterais voir le tableau être copié

Bonjour

"Tilt"

Cdlt

Ce n'est que le début de mon outil, mais cela devrait se présenter comme ça. Il y aura d'autres colonnes remplies encore sur la droite des colonnes roses de la feuille "Etude_agences".

Merci d'avance (et bon appétit).

Cdt

Du coup, je pense que si on peut choisir la zone à copier/trier, on peut peut-être aussi commencer à copier qu'à partir de la ligne 2 ? Je l'ai déjà fait sur d'autres fichiers, mais vu à quoi ressemblent ces macros là je ne vois pas comment faire...

Plus j'avance dans mon outil, plus je me rend compte de mes besoins...

dsl pour le retard, voir le fichier joint

Sub test()
Dim DerLig As Integer
With Sheets("Tab_gen_AE")
DerLig = .Range("A" & Rows.Count).End(xlUp).Row
Sheets("Etude_agences").Range("A:F").ClearContents
    .Range("A1:F1").AutoFilter
    .Range("A1").CurrentRegion.AutoFilter Field:=6, Criteria1:="Oui"
    .Range("A1:F" & DerLig).Copy Sheets("Etude_agences").Range("A1")
    .Range("A1:F1").AutoFilter
End With
End Sub

Merci beaucoup ! Et pas de soucis pour le retard, vous m'avez bien aidée !!

J'allais poser une question mais j'ai réussi à trouver toute seule (j'aurai compris ? )

Bref, merci beaucoup pour votre aide !

Comme tout à l'heure je ne ferme pas le topic tout de suite, on ne sait jamais...

remplace le code précédent par celui-ci pour éviter, entre autres, d'avoir une copie du bouton de la page source sur la page cible

Application.ScreenUpdating = False
With Sheets("Tab_gen_AE")
DerLig = .Range("A" & Rows.Count).End(xlUp).Row
Sheets("Etude_agences").Range("A:F").ClearContents
    .Range("A1:F1").AutoFilter
    .Range("A1").CurrentRegion.AutoFilter Field:=6, Criteria1:="Oui"
    .Range("A1:F" & DerLig).Copy Sheets("Etude_agences").Range("A1")
    .Range("A1:F1").AutoFilter
End With

With Sheets("Etude_agences")
    .Shapes(1).Delete
    .Select
End With

Ca fonctionne parfaitement !

Mais quand on met

 Application.Screenupdating = False

en début de macro, ne faut-il pas mettre

 Application.screenupdating = True

à la fin ?

Sinon tout fonction vraiment bien, merci beaucoup (encore une fois !)

oui, tu as parfaitement raison... termine le code avec

Application.ScreenUpdating = True

Une dernière question, et j'arrêterai là pour aujourd'hui...

J'ai modifié ma fonction dans le fichier que j'ai téléchargé depuis le forum (le dernier) et elle fonctionne très bien. J'ai fait en sorte de ne sélectionner et coller qu'à partir de la ligne 2, ce qui me permet de définir de nouveaux intitulés de colonnes qui ne sont pas effacés lorsque la macro tourne.

Je copie-colle la macro dans mon fichier de travail (tout y est identique à cet endroit, j'ai juste avancé sur d'autres onglets qui n'ont rien à voir), et elle fonctionne toujours mais une erreur '5' s'affiche "Argument ou appel de procédure incorrect".

C'est à n'y rien comprendre

Voici le code en question, avec le fichier, tant qu'à faire...

Sub test()
Dim DerLig As Integer

Application.ScreenUpdating = False

With Sheets("Tab_gen_AE")
DerLig = .Range("A" & Rows.Count).End(xlUp).Row
Sheets("Etude_agences").Range("A2:F" & Rows.Count).ClearContents
    .Range("A2:F2").AutoFilter
    .Range("A2").CurrentRegion.AutoFilter Field:=6, Criteria1:="Oui"
    .Range("A2:F" & DerLig).Copy Sheets("Etude_agences").Range("A2")
    .Range("A2:F2").AutoFilter
End With

With Sheets("Etude_agences")
    .Shapes(1).Delete
    .Select
End With
Application.ScreenUpdating = True

End Sub

remplace ton ancien code par le suivant :

Sub test()

Application.ScreenUpdating = False
With Sheets("Tab_gen_AE")
DerLig = .Range("A" & Rows.Count).End(xlUp).Row
Sheets("Etude_agences").Range("A2:F" & Rows.Count).ClearContents
    .Range("A1:F1").AutoFilter
    .Range("A1").CurrentRegion.AutoFilter Field:=6, Criteria1:="Oui"
    .Range("A2:F" & DerLig).Copy Sheets("Etude_agences").Range("A2")
    .Range("A1:F1").AutoFilter
End With

Sheets("Etude_agences").Select

Application.ScreenUpdating = True
End Sub