filtres excel et formule vba

bonjour, je cherche une formule en vba qui permet de trouver le nombre d'enregistrements obtenus quand des filtres automatiques sont activés dans une liste sous excel.

Sinon mon problème est que j'ai une liste à laquelle je fais subir différents filtres et je veux copier les enregistrements obtenus dans un autre onglet mais que, si il n'y en a pas, il ne se passe rien.
Je pensais avoir trouvé mais quand je mets ça

Code:

---

1 2 3

Range("A2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy

---

et qu'il n'y a aucun résultat de trouvé pour ma sélection de filtres, il me copie le contenu de la cellule A2.

Une proposition

Code:

---

1 2 3 4 5 6

Dim LastLig As Long   LastLig = Range("A65536").End(xlUp).Row If LastLig > 1 Then Range("A1:A" & LastLig).Copy Sheets("FeuilleOùCopier").Range("A3") End If

---

Bonsoir,

Une autre proposition:

Code:

---

1 2 3 4 5

ActiveSheet.Range("$A$1").AutoFilter Field:=10, Criteria1:="=*b0?????05*" X = ActiveSheet.AutoFilter.Range.Columns(10).SpecialCells(xlCellTypeVisible).Cells.Count   Range("A2:C21").SpecialCells(xlCellTypeVisible).Copy Destination:=Range("A24")

---

A adapter

J'ai eu ces morceaux de code sur le forum et je les ai adapté, cela fonctionne très bien pour compter le nombre de lignes filtrées ou pour les copier.

En adaptant à l'aide de la proposition de marc58

Code:

---

1 2 3 4 5

Dim LastLig As Long With Sheets("Feuille Source") LastLig = .Range("A65536").End(xlUp).Row If LastLig > 1 Then .Range("A2:D" & LastLig).SpecialCells(xlCellTypeVisible).Copy Sheets("Feuille Destination").Range("A3") End With

---

Adapter les noms des feuilles et les plages de copie et de destination

j'ai essayé quelques unes des formules que vous m'avez donné mais ça ne fonctionne pas. Je pense que je dois oublier quelque chose. est-ce que quelqu'un pourrait essayer de me l'écrire en entier.

Le fichier où je fais des filtres s'appelle "table essai1.xls" et l'onglet "devis".
Les filtres sont sur différentes colonnes (I, J, K) en même temps et les résultats que je souhaite copier quand il y en a sont dans la colone A.

Le fichier où je dois copier ces données s'appelle "recap mensuel.xls" et l'onglet "R-04-09" et la copie doit se faire à partir de la cellule D304.
Merci

Citation:

---

Sinon mon problème est que j'ai une liste à laquelle je fais subir différents filtres et je veux copier les enregistrements obtenus dans un autre onglet mais que, si il n'y en a pas, il ne se passe rien.

---

Si tu veux des informations précises, tu dois préciser ce que tu veux
si tu ne veux pas essayer d'adapter, c'est facile d'écrire

Citation:

---

est-ce que quelqu'un pourrait essayer de me l'écrire en entier.

---

Si tu as la gentillesse de poster ce que tu as fais et où ça ne fonctionne pas (si cela ne t'est pas pénible :mouarf:)

dans ton cas

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Dim LastLig As Long Dim Wbk as Workbook Dim stFichierComp as string   stFichierComp="C\Mes Documents\recap mensuel.xls" ' à adapter   set Wbk=Workbooks.Open(stFichierComp) With Sheets("devis") LastLig = .Range("A65536").End(xlUp).Row If LastLig > 1 Then .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).Copy Wbk.Sheets("R-04-09").Range("A3") 'Tu ne dis pas où copier End With Set Wbk=Nothing

---

ce code par exemple sur un bouton sur ta feuille devis du fichier table essai1.xls

Bonjour,

Si j'ai bien lu, tu veux copier le résultat de trois filtres consécutifs dans une feuille du même fichier.

Pour réaliser cela, j'ai procédé comme suit (je n'ai pas de code entier)
J'ai filtré ma 1ère colonne:

Code:

---

ActiveSheet.Range("$A$1").AutoFilter Field:=10, Criteria1:="=*b0?????05*"

---

J'ai contrôlé le résultat :

Code:

---

If ActiveSheet.AutoFilter.Range.Columns(10).SpecialCells(xlCellTypeVisible).Cells.Count>1 then

---

et j'ai répété l'opération en imbriquant les conditions:

Ensuite, j'ai copié et collé:

Code:

---

ActiveSheet.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("tasheet").Range("tacellule")

---

Je répète que j'ai trouvé tout cela sur le forum en demandant une recherche sur filtre.

Bon courage

Je mets la formule complète que j'ai utilisé au départ et qui copie la cellule A2 quand il n'y a pas de résultat.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Selection.AutoFilter Field:=12, Criteria1:="<>" Selection.AutoFilter Field:=10, Criteria1:="<>" Selection.AutoFilter Field:=11, Criteria1:=">=39904", Operator:= _ xlAnd, Criteria2:="<=39933" Selection.AutoFilter Field:=2, Criteria1:="FC" Range("A2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Windows("récapitulatifs_mensuels_annuels.xls").Activate Sheets("R-04-09").Select Range("h2").Select ActiveSheet.Paste Range("a1").Select

---

Voilà les deux types de formules que j'ai testé mais quand je le fais les filtres se font mais pas la copie dans l'autre fichier.

Code:

---

1 2 3 4 5 6

Windows("tables essai1.xls").Activate Sheets("devis").Select ActiveSheet.Range("$A$1").AutoFilter Field:=11, Criteria1:="=" X = ActiveSheet.AutoFilter.Range.Columns(11).SpecialCells(xlCellTypeVisible).Cells.Count   Range("A2:a65536").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("R-04-09").Range("d304")

---

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Windows("tables essai1.xls").Activate Sheets("devis").Select Range("A1").Select Selection.AutoFilter Selection.AutoFilter Field:=11, Criteria1:="=" Selection.AutoFilter Field:=9, Criteria1:="<>"   Dim LastLig As Long With Sheets("devis") LastLig = .Range("A65536").End(xlUp).Row If LastLig > 1 Then .Range("A" & LastLig).SpecialCells(xlCellTypeVisible).Copy Windows("récapitulatifs_mensuels_annuels").Sheets("R-04-09").Range("d304")

---

Les données que je dois copier se trouve uniquement dans la colonne A de "tables essai1".
Et je ne peux pas mettre de bouton pour effectuer cette manip parce que je dois répérer ce type d'opérations une bonne 50aine de fois. Ou alors il faudrait que je puisse mettre ce bouton dans le fichier "recap mensuel" dans lequel je dois copier les données obtenues.
Et sinon comme je suis débutante en VBA, elle sert à quoi la formule de mercatog qui peut être mise avec le bouton ?

En fait je dois copier mes données dans un autre fichier, amis comme je n'avais pas bien lu ce que tu avais écrit je l'ai testé quand même. Elle bloque à

Code:

---

ActiveSheet.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("R-04-09").Range("d304")

---

et me dit que l'indice n'appartient pas à la sélection. As-tu une suggestion ?
Il faudrait que je puisse rajouter que c'est dans le fichier"recap mens" que se trouve la feuille "R-04-09" et la cellule "D304"...

Bonjour,

Code:

---

ActiveSheet.SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("recap mens.xls").Sheets("R-04-09").Range("d304")

---

Sinon tu utilises l'enregistrement automatique, ainsi tu auras le code que tu veux.

Bon courage

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14

Dim LastLig As Long Dim Wbk as Workbook Dim stFichierComp as string   stFichierComp="C\Mes Documents\recap mensuel.xls" ' à adapter   set Wbk=Workbooks.Open(stFichierComp) With Sheets("devis") LastLig = .Range("A65536").End(xlUp).Row If LastLig > 1 Then .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).Copy Wbk.Sheets("R-04-09").Range("A3") 'Tu ne dis pas où copier End With Wbk.Save Xbk.Close Set Wbk=Nothing

---

permet de copier les donnée de A2 jusqu'à An de la feuille devis à partir de la cellule A3 de la feuille R-04-09 du fichier recap mensuel.xls que la procédure a ouvert.
j'ai compris que tu a des filtres, tu choisis les critère et tu voulais copier le résultat ailleurs!!

si je fais enregistrement automatique ça me donne ça

Code:

---

1 2 3 4 5 6 7

Range("A2:A14").Select Selection.Copy Windows("récapitulatifs_mensuels_annuels.xls").Activate Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Windows("tables essai1.xls").Activate Application.CutCopyMode = False

---

et je ne sais pas comment l'adapter...

j'ai essayé ta formule mais il me dit que sheets("devis") n'appartient pas à la sélection...

Bonjour,

Peux-tu essayer avec cela

Code:

---

ActiveSheet.SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("récapitulatifs_mensuels_annuels.xls").Sheets("R-04-09").Range("d304")

---

Citation:

---

j'ai essayé ta formule mais il me dit que sheets("devis") n'appartient pas à la sélection...

---

Si tu lances le procédure à partir de ton classeur Facturation.xls
et si ta feuille s'appelle bien "devis"
et à mesure de changer à main levée sans tester,
voilà le résultat (en fait après l'ouverture du fichier Wbk, il devient le Classeur actif, d'où l'erreur)

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

Dim LastLig As Long Dim Wbk As Workbook, aWbk As Workbook Dim stFichierComp As String   stFichierComp = "C\Mes Documents\recap mensuel.xls" ' à adapter   Set aWbk = ThisWorkbook Set Wbk = Workbooks.Open(stFichierComp)   With aWbk.Sheets("devis") LastLig = .Range("A65536").End(xlUp).Row If LastLig > 1 Then .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).Copy Wbk.Sheets("R-04-09").Range("A3") 'Tu ne dis pas où copier End With Wbk.Save Wbk.Close Set Wbk = Nothing Set aWbk = Nothing

---

J'ai testé ce que vous m'avez dit et voilà le résultat :

Code:

---

1 2 3 4 5 6 7 8 9

Sub essai()   ActiveSheet.Range("$A$1").AutoFilter Field:=11, Criteria1:="=" X = ActiveSheet.AutoFilter.Range.Columns(11).SpecialCells(xlCellTypeVisible).Cells.Count   ActiveSheet.SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("récapitulatifs_mensuels_annuels.xls").Sheets("R-04-09").Range("d304")     End Sub

---

Windows me dit que l'indice n'appartient pas à la sélection.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Sub essai()   Selection.AutoFilter Field:=12, Criteria1:="<>" Selection.AutoFilter Field:=10, Criteria1:="<>"   Dim LastLig As Long Dim Wbk As Workbook, aWbk As Workbook Dim stFichierComp As String   stFichierComp = "H:\récapitulatifs_mensuels_annuels.xls" ' à adapter   Set aWbk = ThisWorkbook Set Wbk = Workbooks.Open(stFichierComp)   With aWbk.Sheets("devis") LastLig = .Range("A65536").End(xlUp).Row If LastLig > 1 Then .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).Copy Wbk.Sheets("R-04-09").Range("A3") 'Tu ne dis pas où copier End With   Set Wbk = Nothing Set aWbk = Nothing   End Sub

---

Le programme s'exécute sans bogage mais il n'y a rien de copié dans récap mens.

J'ai vraiment besoin que ça marche, au secours SVP !

Tu peux joindre ton fichier avec bien sûr peu de donnée, parce que j'ai testé sur un exemple personnel et ça fonctionne chez moi

ci joint mon exemple; j'ai mis mes critères du filtre

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Dim LastLig As Long Dim Wbk As Workbook, aWbk As Workbook Dim stFichierComp As String Dim plage As Range   stFichierComp = "C:\Users\user\Desktop\DEVELOPPEZ\AAAAmine-mercredi-06-2002.xls" ' à adapter   Set aWbk = ThisWorkbook Set Wbk = Workbooks.Open(stFichierComp)     With aWbk.Sheets("devis") Set plage = .Range("A1:D" & .Range("A65536").End(xlUp).Row) plage.AutoFilter 'pour supprimer les filtres existants plage.AutoFilter Field:=4, Criteria1:="<>A" plage.AutoFilter Field:=3, Criteria1:="<>2000"   LastLig = .Range("A65536").End(xlUp).Row If LastLig > 1 Then .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).Copy Wbk.Sheets("AAA").Range("A3") 'Tu ne dis pas où copier End With   Set Wbk = Nothing Set aWbk = Nothing

---

voilà mon essai mais il me dit qu'il ne peut pas coller parce qu'il y a des différences de formats de cellules. En plus cet essai est fait sous Excel 2007 mais j'utilise Excel 2003 pour mon programme en réalité. C'est peut-être ce qui se passe sous Excel 2003 quand je lance mon programme à part qu'il ne me le dit pas..

Ci-joint fichier facturation avec un exemple de filtre!
adapter dans le code du bouton le chemin complet du fichier récapitulatifs_mensuels_annuels.xls

Effectivement j'ai testé ta macro et ça marche mais est-ce que tu pourrais me dire comment faire pour que tout cela se fasse à partir du fichier "récap mens" et pas de "facturation".