Filtre automatique des données sur VBA

voici la macro et le fichier

Sub Filtre()

Dim J As Long, Nblg As Long

Dim Ws As Worksheet

Dim Tablo()

Dim I As Integer, Indice As Integer

Application.ScreenUpdating = False

Set Ws = ActiveSheet

If Ws.FilterMode = True Then Ws.ShowAllData

Nblg = Range("F" & Rows.Count).End(xlUp).Row

ReDim Tablo(0)

For J = 3 To Nblg

For I = 0 To UBound(Tablo)

If Tablo(I) = Range("F" & J) Then Exit For

Next I

If I > UBound(Tablo) Then

ReDim Preserve Tablo(Indice)

Tablo(Indice) = Range("F" & J)

Indice = Indice + 1

End If

Next J

Range("M2") = Range("F2")

For I = 0 To UBound(Tablo)

Ws.Range("M3") = Tablo(I)

If FeuilleExiste(CStr(Tablo(I))) = False Then

Sheets.Add(after:=Sheets(Sheets.Count)).Name = Tablo(I)

End If

With Sheets(Tablo(I))

.Cells.Clear

Ws.Range("A6:I" & Nblg).AdvancedFilter Action:=xlFilterCopy, criteriarange:=Ws.Range("M2:M3"), copytorange:=.Range("A1:I1")

End With

Next I

With Ws

.Range("M2:M3").ClearContents

.Select

End With

End Sub

Function FeuilleExiste(Nom As String) As Boolean

On Error Resume Next

FeuilleExiste = Sheets(Nom).Name <> ""

On Error GoTo 0

End Function

macro au cas ou

et feuille

là c'est sur tu dois avoir la macro avec

Bonjour

A vérifier

Merci je pense que j'avais oublier F5 et "A5:I"

Bobjour,

voici deux fichiers dans un meme dossier.

mon but etant de completer mon fichier "Book1" en fonction des elements du fichier nomé "zlam Filtres V0021"

Mais pour completer mon fichier Book1 cela se fait trimestriellement d'ou les Q1; Q2,Q3 qui me permettent de faire des filtres.

et apres faire des recherchesV /

j'ai reussi a faire une macro^pour les filtres mais en realité je devais faire ma macro dans "book1" car dams mon fichier "zlam Filtres V0021" des colonnes peuvent etre rajouté a tout moment et pas par moi. ce qui suppose que ma macro dans ce cas devait etre modifier contituellement .

pouvez vous regarder ma macro et me proposer quelque svp

Les element de la colonne F du fichier Book1 doivent etre rempli aussi.

Merci d'avance

Bonjour

Outre le fait que je ne comprends pas grand chose à ce que tu veux faire

Que ta macro soit dans n'importe quel fichier, si des modifications ont lieu dans la base il faudra OBLIGATOIREMENT modifier la macro

Ou alors (en plus compliqué) faire en sorte que la macro "passe partout" et encore ce n'est pas sur que l'on pourra prévoir tous les cas

ok je me doutais bien que je me suis mal exprimé.

en somme, je voudrais juste une macro qui puisse me completer mon fichier Book1 en extrayant les données dans mon second fichier. mais toutefois sans modifier mon second fichier (ni rajouter des feuilles ou auoique ce soit).

le plus important c'es que c'est informations sont filtrées tous les trimestres avec donc Q1,Q2,Q3 representant les trimestre.

Merci et j'espere que j'ai finalement reussi a faire passer la mesage.

Bonjour

zlam a écrit :

une macro qui puisse me completer mon fichier Book1

Comment ça compléter ?

Tu veux le résultats des filtres sur des feuilles dans ton fichier "Book1" ?

oui

exactement. et de là faire une macro ou rechercheV pour completer mon tableau.

Bonjour

Voilà j'ai déplacé la macro

merci mais j'ai un message d'erreur "run-time error "68"

device unavailable a la ligne 11

Aussi si je peux me permettre,

quels sont les éléments a changer vu que je vais l'appliquer a un fichier plus gros

Merci

Bonjour

Remplaces la ligne

Chemin = ThisWorkbook.Path & "\"

par celle-ci

Chemin = ThisWorkbook.Path & Application.PathSeparator

ça ne marche toujours pas

toujours pas de solutions

Bonsoir

Tu as un Mac et je n'en possède pas (tant mieux - juste un avis personnel)

Donc difficile de tester

Peut-être un (heureux ?) possesseur de cette machine pourra trouver le pourquoi

Juste pour savoir : Tu peux dire à quoi ressemble le résultat de

Chemin = ThisWorkbook.Path & Application.PathSeparator
MsgBox Chemin

Merci

Zut meme résultat

Bien dans ce cas j'essayerai demain avec un ordi normal.et je te tiendrai informé

merci pour tout!

parcontre peux tu me mettre en couleur différentes les variables que je dois changer lorsque je vais coller la micro pour l'adapter a mon nouveau fichier excel 2010 qui contient n fois plus de données que ce dernier fichier sur lequel on travail.

Merci

Bonjour,

Testé sous Mac Excel 2011.

Cdlt

Option Explicit
Public Sub Filtre()
      Dim J As Long, Nblg As Long
      Dim Ws As Worksheet, WsBase As Worksheet, WbBase As Workbook
      Dim Tablo()
      Dim I As Integer, Indice As Integer
      Dim Chemin As String, Fichier As String

10        Application.ScreenUpdating = False
20        Set Ws = ActiveSheet
          ' Windows
          'Chemin = ThisWorkbook.Path & "\"
         ' Mac
30        Chemin = ThisWorkbook.Path & ":"
40        Fichier = "zlam Filtres sans macro.xlsx"
          ' Windows & Mac
50        If Dir(Chemin & Fichier) = "" Then
60            MsgBox "Fichier " & Fichier & " introuvable"
70            Exit Sub
80        End If
          'Windows
          'Set WbBase = Workbooks.Open(Chemin & Fichier)
          'Mac
90        Workbooks.Open Filename:=Chemin & Fichier
100       Set WbBase = ActiveWorkbook
110       Set WsBase = WbBase.Sheets(1)
120       If WsBase.FilterMode = True Then WsBase.ShowAllData
130       Nblg = WsBase.Range("F" & Rows.Count).End(xlUp).Row
140       ReDim Tablo(0)
150       For J = 3 To Nblg
160           For I = 0 To UBound(Tablo)
170               If Tablo(I) = WsBase.Range("F" & J) Then Exit For
180           Next I
190           If I > UBound(Tablo) Then
200               ReDim Preserve Tablo(Indice)
210               Tablo(Indice) = WsBase.Range("F" & J)
220               Indice = Indice + 1
230           End If
240       Next J
250       Ws.Range("K1") = WsBase.Range("F2")
260       For I = 0 To UBound(Tablo)
270           Ws.Range("K2") = Tablo(I)
280           If FeuilleExiste(ThisWorkbook, CStr(Tablo(I))) = False Then
290               ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) _
                      .Name = Tablo(I)
300           End If
310           With ThisWorkbook.Sheets(Tablo(I))
320               .Cells.Clear
330               WsBase.Range("A2:J" & Nblg).AdvancedFilter Action:=xlFilterCopy, _
                      criteriarange:=Ws.Range("K1:K2"), copytorange:=.Range("A1:J1")
340           End With
350       Next I
360       WbBase.Close savechanges:=False
370       With Ws
380           .Range("K1:K2").ClearContents
390           .Select
400       End With
End Sub

Bonjour

Merci Jean-Eric de t'investir dans la résolution des problèmes de cette macro

Pour ma culture personnelle peux tu me dire le résultat de cette partie lorsque le code est effectué avec un Mac

Chemin = ThisWorkbook.Path & Application.PathSeparator
MsgBox Chemin

Merci

Re,

Chemin = ThisWorkbook.Path & Application.PathSeparator

correspond à

Chemin = ThisWorkbook.Path & ":"

Cdlt

Bobjour;

je suis de nauveau sur un PC normal et la premiere macro que vous m'aviez donnée fonctionne.

cependant j'ai oublier un detail, ce que dans mon fichier 'zlam Filtres sans macro' il y a plusieurs feuilles et donc il me faut selection la feuille 1 comme dans mon example comme source.

idem pour le deuxieme ficheir il ya plusieurs feuilles

comme je suis le pro des nul je sais ps le faire pouriez vous une fois de plus m'aider

Cordialement.

Bonjour

La feuille 1 est sélectionnée dans le classeur " zlam Filtres sans macro.xlsx"

90        Workbooks.Open Filename:=Chemin & Fichier
100       Set WbBase = ActiveWorkbook
110       Set WsBase = WbBase.Sheets(1)
120       If WsBase.FilterMode = True Then WsBase.ShowAllData

Pour la feuille dans le classeur "zlam Book1 V001.xlsm"

La feuille sélectionnée est la feuille ayant le bouton : Places le bouton sur la bonne feuille