Filtre élaboré en VBA
Résolu
Juju
-
Juju -
Juju -
Bonjour,
J'ai une colonne de données je cherche à écrire le code en VBA pour que dans ma colonne F il trie les données de manière a rendre visible uniquement les lignes dont la valeur de la collonne F est supérieur à 5...
Du gateau pour certain ... moins pour d'autre merci de vos conseils avisés !
J'ai une colonne de données je cherche à écrire le code en VBA pour que dans ma colonne F il trie les données de manière a rendre visible uniquement les lignes dont la valeur de la collonne F est supérieur à 5...
Du gateau pour certain ... moins pour d'autre merci de vos conseils avisés !
A voir également:
- Filtre élaboré en VBA
- Photo filtre 7 gratuit - Télécharger - Retouche d'image
- Filtre whatsapp - Accueil - Messagerie instantanée
- Filtre teams - Accueil - Visio
- Filtre manga - Accueil - TikTok
- Excel compter cellule couleur sans vba - Guide
4 réponses
bonjour
Si j'ai bien décodé ta question :
Tu emploie à tord "trier" alors que tu veux "filtrer" : lorsque l'on trie on modifie l'ordre des données mais lorsque l'on filtre on les sélectionne.
Si j'ai bien décodé ta question :
Range("F1").AutoFilter Field:=6, Criteria1:=">5"
Tu emploie à tord "trier" alors que tu veux "filtrer" : lorsque l'on trie on modifie l'ordre des données mais lorsque l'on filtre on les sélectionne.
merci beaucoup pour ton petit coup de pouce... cela fonctionne !!
et pour le vocabulaire qui en effet semble être inexacte....
Cependant ce que tu m'as mis incrémente un trieur a toutes mes colonnes ... je veux que les personnes qui se servent du fichiers ne voient que les données > à 5 après éxécutions de ma macro... je me rend compte que la seule possibilité de faire cela est de créer une macro qui copie les lignes correspondant dont la case en F est supp a 5...dans un autre fichier comme ce que j'ai essayé de faire dans un premier temps ici...
ma maccro est la suivante mais elle plante....
:(
Sub Test_copie_valeures()
' COPIE DES LIGNES DESIREES DANS LES FEUILLES DE CALCUL DEDIEES
Dim Rw As Range
Dim Ligne As Long
' Sélectionne l'ensemble des données (utile pour qu'Excel ne "réfléchisse" pas sur les 65000 lignes)
Windows("XT.xls").Activate
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select
' Boucle qui va passer sur chaque ligne de la sélection afin de déterminer si des lignes contiennent le flag voulu
' sélection puis copie dans un autre tableur(copie de XT vers XR) en conservant la même forme des données
(Ca devient très bancale a partie de là je crois....la colonne que je cherche a trier est la colonne F soit la 6e dans XT je cherche a copier toutes les lignes de XT feuilles de Janvier dans XR)
For Each Rw In Selection.Rows
Ligne = Rw.Row
If Rw.Cells(Ligne, 6).Value > "5" Then
plantage en dessous..........................................................
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("XR.xls").Activate
Sheet
ActiveSheet.Paste
Rw.Copy Worksheets("Janvier").Cells(Ligne, 1).EntireRow
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next Rw
' Pop-up d'avertissement de fin de macro.
MsgBox "Bla bla bla.", vbOKOnly, "Macro terminée"
End Sub
bon voilà le topo intégrale peux tu m'aider ?
et pour le vocabulaire qui en effet semble être inexacte....
Cependant ce que tu m'as mis incrémente un trieur a toutes mes colonnes ... je veux que les personnes qui se servent du fichiers ne voient que les données > à 5 après éxécutions de ma macro... je me rend compte que la seule possibilité de faire cela est de créer une macro qui copie les lignes correspondant dont la case en F est supp a 5...dans un autre fichier comme ce que j'ai essayé de faire dans un premier temps ici...
ma maccro est la suivante mais elle plante....
:(
Sub Test_copie_valeures()
' COPIE DES LIGNES DESIREES DANS LES FEUILLES DE CALCUL DEDIEES
Dim Rw As Range
Dim Ligne As Long
' Sélectionne l'ensemble des données (utile pour qu'Excel ne "réfléchisse" pas sur les 65000 lignes)
Windows("XT.xls").Activate
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select
' Boucle qui va passer sur chaque ligne de la sélection afin de déterminer si des lignes contiennent le flag voulu
' sélection puis copie dans un autre tableur(copie de XT vers XR) en conservant la même forme des données
(Ca devient très bancale a partie de là je crois....la colonne que je cherche a trier est la colonne F soit la 6e dans XT je cherche a copier toutes les lignes de XT feuilles de Janvier dans XR)
For Each Rw In Selection.Rows
Ligne = Rw.Row
If Rw.Cells(Ligne, 6).Value > "5" Then
plantage en dessous..........................................................
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("XR.xls").Activate
Sheet
ActiveSheet.Paste
Rw.Copy Worksheets("Janvier").Cells(Ligne, 1).EntireRow
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next Rw
' Pop-up d'avertissement de fin de macro.
MsgBox "Bla bla bla.", vbOKOnly, "Macro terminée"
End Sub
bon voilà le topo intégrale peux tu m'aider ?
Bonjour,
je post pour te faire avancé et gbinforme te corrigera ....
précise bien les où se trouvent les données (source et but) ex : source de A1 à F18 à copier vers...
'ci-dessous.... ton code
F soit la 6e dans XT je cherche a copier toutes les lignes de XT feuilles de Janvier dans XR)
For Each Rw In Selection.Rows
Ligne = Rw.Row
If Rw.Cells(Ligne, 6).Value > "5" Then
'plantage en dessous..........................................................
rw.select ' cette ligne copiera la ligne de ta sélection .
' attention il y aura un clignotement entre les classeurs
'Range(Selection, Selection.End(xlToRight)).Select ' cela copie toute la sélection.
Selection.Copy
Windows("XR.xls").Activate
'Sheet
ActiveSheet.Paste
'Rw.Copy Worksheets("Janvier").Cells(Ligne, 1).EntireRow
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next Rw
je post pour te faire avancé et gbinforme te corrigera ....
précise bien les où se trouvent les données (source et but) ex : source de A1 à F18 à copier vers...
'ci-dessous.... ton code
F soit la 6e dans XT je cherche a copier toutes les lignes de XT feuilles de Janvier dans XR)
For Each Rw In Selection.Rows
Ligne = Rw.Row
If Rw.Cells(Ligne, 6).Value > "5" Then
'plantage en dessous..........................................................
rw.select ' cette ligne copiera la ligne de ta sélection .
' attention il y aura un clignotement entre les classeurs
'Range(Selection, Selection.End(xlToRight)).Select ' cela copie toute la sélection.
Selection.Copy
Windows("XR.xls").Activate
'Sheet
ActiveSheet.Paste
'Rw.Copy Worksheets("Janvier").Cells(Ligne, 1).EntireRow
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next Rw
bonjour
je veux que les personnes qui se servent du fichiers ne voient que les données > à 5 après éxécutions de ma macro...
Si j'ai compris ce que tu veux, cette macro devrait le faire
Tu ouvres "XT.xls" où tu as ta macro, tu lances ta macro,
- elle sélectionne tes données sur une autre feuille que j'ai appelé "sélection"
( mais tu mets le nom que tu veux en tête )
- elle sauvegarde ta sélection dans "WR.xls" ( comme tu voulais faire )
- "XT.xls" se ferme et il te reste à l'écran ta sélection.
je veux que les personnes qui se servent du fichiers ne voient que les données > à 5 après éxécutions de ma macro...
Si j'ai compris ce que tu veux, cette macro devrait le faire
Public Sub Test_copie_valeurs()
Const nom = "sélection"
Windows("XT.xls").Activate
Sheets.Add.Name = nom
Sheets("F2").Activate
Range("A1").AutoFilter Field:=6, Criteria1:=">5"
Cells.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets(nom).Cells(1, 1)
Range("A1").AutoFilter
Application.DisplayAlerts = False
Sheets(nom).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\WR.xls"
Windows("XT.xls").Activate
Sheets(nom).Delete
Application.DisplayAlerts = True
ActiveWorkbook.Close True
End Sub
Tu ouvres "XT.xls" où tu as ta macro, tu lances ta macro,
- elle sélectionne tes données sur une autre feuille que j'ai appelé "sélection"
( mais tu mets le nom que tu veux en tête )
- elle sauvegarde ta sélection dans "WR.xls" ( comme tu voulais faire )
- "XT.xls" se ferme et il te reste à l'écran ta sélection.
après quelques heures de boulot et un coup de main de ponpon...
Option Explicit
Sub FiltrerCopierVersClasseurCopy()
Dim objsource As Workbook, objcible As Workbook
Dim shmois As String
Dim li, msg, nbli, rep, style, titre, w
' *** Le classeur source et la feuille concernée
Set objsource = ActiveWorkbook
shmois = ActiveSheet.Name
' *** Valider le classeur cible ... est-il déjà ouvert
If Workbooks.Count = 1 Then GoTo NonOuvert
For Each w In Workbooks
If w.Name <> ThisWorkbook.Name Then
msg = "Classeur ouvert : " & w.Name & Chr(13) & "S'il sagit du classeur de copie, clic sur Valider . Autrement clic Non."
style = vbYesNo
titre = "Valider classeur qui recoit les copies"
rep = MsgBox(msg, style, titre)
If rep = vbYes Then ' L'utilisateur a choisi Oui.
Set objcible = Workbooks(w.Name)
objsource.Activate
GoTo Suite
End If
End If
Next w
NonOuvert:
MsgBox ("Le classeur de copie n'est pas ouvert.")
Set objcible = Workbooks.Open(Application.GetOpenFilename)
Windows(objsource.Name).Activate
Suite:
' *** Recherche des valeurs supérieur à 5 dans la colonne "F" si oui copier ligne vers classeur de copy
Worksheets(shmois).Select
With Sheets(shmois)
nbli = 0
For li = 3 To Range("A65536").End(xlUp).Row
If Cells(li, 6).Value > 5 Then
Range(Cells(li, 1), Cells(li, 12)).Copy Destination:=objcible.Sheets(shmois).Range("A" & objcible.Sheets(shmois).Range("A65536").End(xlUp).Row + 1)
nbli = nbli + 1
End If
Next li
End With
MsgBox ("Les " & nbli & " lignes de données sont copiées dans " & objcible.Name & ", feuille : " & shmois & "")
End Sub
voilà ma macro si elle peut servir à d'autre !
Merci de votre aide les gars cela m'a permis d'avancer et de voir mon projet sous un autre angle !
;) bonne continuation et a bientôt.... !!
merci encore !
Option Explicit
Sub FiltrerCopierVersClasseurCopy()
Dim objsource As Workbook, objcible As Workbook
Dim shmois As String
Dim li, msg, nbli, rep, style, titre, w
' *** Le classeur source et la feuille concernée
Set objsource = ActiveWorkbook
shmois = ActiveSheet.Name
' *** Valider le classeur cible ... est-il déjà ouvert
If Workbooks.Count = 1 Then GoTo NonOuvert
For Each w In Workbooks
If w.Name <> ThisWorkbook.Name Then
msg = "Classeur ouvert : " & w.Name & Chr(13) & "S'il sagit du classeur de copie, clic sur Valider . Autrement clic Non."
style = vbYesNo
titre = "Valider classeur qui recoit les copies"
rep = MsgBox(msg, style, titre)
If rep = vbYes Then ' L'utilisateur a choisi Oui.
Set objcible = Workbooks(w.Name)
objsource.Activate
GoTo Suite
End If
End If
Next w
NonOuvert:
MsgBox ("Le classeur de copie n'est pas ouvert.")
Set objcible = Workbooks.Open(Application.GetOpenFilename)
Windows(objsource.Name).Activate
Suite:
' *** Recherche des valeurs supérieur à 5 dans la colonne "F" si oui copier ligne vers classeur de copy
Worksheets(shmois).Select
With Sheets(shmois)
nbli = 0
For li = 3 To Range("A65536").End(xlUp).Row
If Cells(li, 6).Value > 5 Then
Range(Cells(li, 1), Cells(li, 12)).Copy Destination:=objcible.Sheets(shmois).Range("A" & objcible.Sheets(shmois).Range("A65536").End(xlUp).Row + 1)
nbli = nbli + 1
End If
Next li
End With
MsgBox ("Les " & nbli & " lignes de données sont copiées dans " & objcible.Name & ", feuille : " & shmois & "")
End Sub
voilà ma macro si elle peut servir à d'autre !
Merci de votre aide les gars cela m'a permis d'avancer et de voir mon projet sous un autre angle !
;) bonne continuation et a bientôt.... !!
merci encore !
