macro copier coller avec filtre

  • Initiateur de la discussion Initiateur de la discussion gael69
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

gael69

XLDnaute Nouveau
Bonjour à tous,

J'ai une macro fonctionnant assez bien mais que je voudrais améliorer pour ne copier coller que certaines colonnes et non pas tout les lignes contenant des données
Sub Macrobiochimie()

Sheets("Suivi global BHU").Select
Selection.AutoFilter Field:=11, Criteria1:="Biochimie"
Selection.AutoFilter Field:=16, Criteria1:="=Actif", Operator:=xlOr, _
Criteria2:="=Inactif"
Rows("10:500").Select
Range("N10").Activate
Selection.Copy
Sheets("Radar biochimie").Select
Range("A1").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells.Select
ActiveSheet.Paste
Selection.AutoFilter
Sheets("Suivi global BHU").Select
Range("A1").Select
Application.CutCopyMode = False
End Sub

Il faudrait que ca ne copie colle que les colonnes : C I J K N O P Q

Ci dessous la macro que je tente de modifier en vain ( en gras ). Je suppose qu'il faut ajouter d'autres critères ( on m'a exposé oralement d'utiliser du activewindow.scroll column en fin de macro mais comment ... that the question)

Sub Macrobiochimie()

Sheets("Suivi global BHU").Select
Selection.AutoFilter Field:=11, Criteria1:="Biochimie"
Selection.AutoFilter Field:=16, Criteria1:="=Actif", Operator:=xlOr, _
Criteria2:="=Inactif"
Rows("10:500").Select
Range("N10").Activate
Range("C:C,I:I,J:J,K:K,N:N,O:O,P😛,Q:Q").Activate
Selection.Copy
Sheets("Radar biochimie").Select
Range("A1").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells.Select
ActiveSheet.Paste
Selection.AutoFilter
Sheets("Suivi global BHU").Select
Range("A1").Select
Application.CutCopyMode = False
End Sub

Je vous remercie par avance pour votre aide et conseils !

Cdlt

Gael
 
Re : macro copier coller avec filtre

Bonjour

sans savoir ce que vous voulez faire et sans le classeur avec des données pour réaliser des tests pas certain de répondre sûrement:

Code:
Sheets("Suivi global BHU").Select
Selection.AutoFilter Field:=11, Criteria1:="Biochimie"
Selection.AutoFilter Field:=16, Criteria1:="=Actif", Operator:=xlOr, _
Criteria2:="=Inactif"

DerLig = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Range("C1:C" & DerLig & ",I1:K" & DerLig & ",N:Q" & DerLig).SpecialCells(xlCellTypeVisible).Copy 
Sheets("Radar biochimie").Range("A1").Paste

ActiveSheet.AutoFilter

Range("A1").Select
Application.CutCopyMode = False

A+
 
Re : macro copier coller avec filtre

Bonjour,

Je te joins le fichier j'avais des données sensible que j'ai supprimé
http://cjoint.com/?3BzkPLTU4Yu

Comme précisé .... RADAR
Si je clique sur le bouton cosmétique dans l'onglet " suivi global BHU"
Et si dans la colonne P apparaît le mot "actif" ou "inactif", il faudrait que excel puisse copier et coller automatiquement les lignes dans l'onglet correspondant "onglet radar cosmétique".
Le critère numéro 2 est donc cosmétique ( colonne K). De même si je clique sur biochimie ou plasma etc ... que excel copie dans l'onglet correspondant suivant le critère 2 (plasma ou biochimie etc...)

Colonnes à copier : C F I J K N P Q

Pour l'instant ca copie mais sans filtrer les colonnes.

Je te remercie pour ton aide

Gael
 
Re : macro copier coller avec filtre

Re,

peu de modification au code déjà proposé:

Code:
Sub Macrocosmétique()
Dim DerLig As Long, Plage As String, MonCritere As String
Dim WS1 As Worksheet, WS2 As Worksheet

Set WS1 = Worksheets("Suivi global BHU")

Set WS2 = Worksheets("Feuil1")
MonCritere = "Cosmétique"

'met la feuille source en mode filtre si elle ne l'est pas
If Not WS1.AutoFilterMode Then WS1.Range("A1:I1").AutoFilter
  
'tri selon  les critères
WS1.Range("A10").AutoFilter Field:=11, Criteria1:=MonCritere
WS1.Range("A10").AutoFilter Field:=16, Criteria1:="=Actif", Operator:=xlOr, Criteria2:="=Inactif"
'détermination de la dernière ligne du tableau
DerLig = WS1.Range("A" & Rows.Count).End(xlUp).Row
'copie la feuille origine sur la feuille source
Plage = "C10:C" & DerLig & ",F10:F" & DerLig & ",I10:K" & DerLig & ",N10:N" & DerLig & ",P10:Q" & DerLig
WS1.Range(Plage).SpecialCells(xlCellTypeVisible).Copy WS2.Range("A1") ' sur une seule ligne

'met la feuille cible en mode filtre si elle ne l'est pas
If Not WS2.AutoFilterMode Then WS2.Range("A1:I1").AutoFilter
'adapte les colonnes au contenu
WS2.Columns("A:H").AutoFit
'supprime la trace de sélection
Application.CutCopyMode = False

'se repositionne sur feuille source en A1
WS1.Range("A1").Select

End Sub

facilement adaptable pour d'autre recherche, il suffit de modifier les deux éléments suivants , soit en dur soit en passant des paramètres:
Set WS2 = Worksheets("Feuil1"): Feuil1 est la feuille de destination
MonCritere = "Cosmétique" : Cosmétique est le critère de tri variable

A+
 
Re : macro copier coller avec filtre

Merci bcp surtout pour l'explication !

Last question : Parfait pour le copier coller et la filtration des colonnes ... jusqu'à la colonne Q
Plage = "C10:C" & DerLig & ",F10:F" & DerLig & ",I10:K" & DerLig & ",N10:N" & DerLig & ",P10:Q" & DerLig

Après la colonne Q plus aucun filtre, il me colle tout le reste des colonnes. Comment signaler que la colonne Q est la dernière que l'on veut voir collée ? en gros comment clôturer la sélection des colonnes copiée collée.

Merci
 
Re : macro copier coller avec filtre

Re,
J'ai fait les tests sur la feuille Feuil1 vierge de toute information: RaS seules les colonnes spécifiées sont copiées.

s'il y a des colonnes "en trop" après la copie sur feuille Radar cosmétique c'est qu'elles y étaient auparavant.

Solution rajouter dans le code de la macro juste avant:
Code:
'copie la feuille origine sur la feuille source
la ligne de code:
Code:
WS2.Cells.Delete

Toutes les données de cette feuille cibles seront supprimées avant la copie.

A+
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
10
Affichages
547
Réponses
3
Affichages
339
Réponses
12
Affichages
970
Réponses
17
Affichages
1 K
Réponses
1
Affichages
406
Retour