filtre sur plusieurs onglets

Bonjour,

Voici un exemple de code...

Tu places ce code dans un module standard du fichier
qui doit afficher le résultat des filtres des 3 onglets du classeur
où se retrouvent tes données

Le nom des clients se retrouve sur la colonne 18 comme tu as
indiqué dans ta question.

Prends le temps le lire la procédure, et renseigne les variables selon
ton environnement de travail.

'----------------------------------------
Sub test()
Dim Rg As Range, NomClient As Variant
Dim Arr(), Elt As Variant, LastRow As Long
Dim DerLig As Long, DerCol As Integer
Dim Rg1 As Range, Col As Integer, Wk As Workbook
Dim NomFichier As String, Chemin As String

'Chemin où se retrouve le fichier
Chemin = "c:UsersDMDocuments"
'Nom du fichier
NomFichier = "Classeur1.xls"

'Vérification que le fichier existe...
If Dir(MonChemin & Fichier) = "" Then
MsgBox "Fichier non trouvé."
Exit Sub
End If

'ouverture du fichier où sont les 3 feuilles de données
'Chemin et nom de fichier à spécifier
On Error Resume Next
'Si le fichier est ouvert :
Set Wk = Fichier
If Err <> 0 Then
Err = 0
Set Wk = Workbooks.Open(Chemin & NomFichier)
End If

'Détermination des clients recherchés sur les 3 onglets
NomClient = Application.InputBox(prompt:= _
"Identifiez le nom du client", Type:=2)
'Si vous avez cliquer sur le bouton annulé de la fenêtre
If NomClient = "False" Then
MsgBox "Vous avez annulé l'opération."
Exit Sub
End If
'Si vous avez fermé la fenêtre par OK sans rien inscrire
If NomClient = "" Then
MsgBox "Aucun client identifié. Opération annulée."
Exit Sub
End If

'La colonne où se retrouve la liste des clients
Col = 18

'Nom Des onglets des feuilles à traiter pour le nom du client
Arr = Array("Sheet1", "Sheet2", "Sheet3")

For Each Elt In Arr
With Wk.Worksheets(Elt)
'Trouve la dernière ligne occupée de la feuille
DerLig = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

'Trouve la dernière colonne occupée de la feuille
DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

'délimitation de la plage occupée de la feuille
'affectée à une variable objet Range
Set Rg = .Range("A1", .Cells(DerLig, DerCol))
End With

'Utilisation de la Variable objet Rg pour effectuer
'un filtre élaboré ou avancé sur la colonne 18 OU R:R
With Rg
.AutoFilter Field:=Col, Criteria1:=NomClient
'Détermination de la plage à copier
If Application.Subtotal(3, Worksheets(Elt).Columns(Col)) - 1 > 0 Then
Set Rg1 = Rg.Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible)
'Nom Feuille à adapter où le résultat sera affiché.
With ThisWorkbook.Worksheets("Sheet1")
'Copie la première ligne - Les étiquettes de colonnes
Rg(1).EntireRow.Copy .Range("A1")

'Déterminer la ligne où copier les enregistrements
LastRow = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1

'Copier la plage résultant du filtre
Rg1.Copy .Range("A" & LastRow)
End With
End If
'Enlève le filtre sur la plage
.AutoFilter
End With
Next
End Sub
'----------------------------------------

--
MichD
--------------------------------------------


"STEPH B" <stephol@prodiag.fr> a écrit dans le message de groupe de discussion :
4c988102$0$32431$ba4acef3@reader.news.orange.fr...
Bonjour
je dispose d un fichier excel qui contient des onglets nommés 2008 -
2009-2010
sur ces trois onglets je dispose d une colonne numero 18 qui contient
plusieurs noms de clients.

je voudrais si possible..
que création d un fichier excel nommé yyyy par exemple stocké sur mon bureau
et il revient sur le fichier à traiter
et que sur les 3 onglets si la cellule est égale à "*xxx*" alors il copie la
ligne entiere sur le fichier yyyy

merci d avance pour cette aide

C'est la même procédure mais j'ai pris soin de désactiver certains éléments lors de l'exécution de la macro.

Sub test()

Dim Rg As Range, NomClient As Variant
Dim Arr(), Elt As Variant, LastRow As Long
Dim DerLig As Long, DerCol As Integer
Dim Rg1 As Range, Col As Integer, WK As Workbook
Dim NomFichier As String, Chemin As String
Dim ModCalcul As String

ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

'Chemin où se retrouve le fichier
Chemin = "c:UsersDMDocuments"
'Nom du fichier
NomFichier = "Classeur1.xls"

'Vérification que le fichier existe...
If Dir(MonChemin & Fichier) = "" Then
MsgBox "Fichier non trouvé."
Exit Sub
End If

'ouverture du fichier où sont les 3 feuilles de données
'Chemin et nom de fichier à spécifier
On Error Resume Next
'Si le fichier est ouvert :
Set WK = Fichier
If Err <> 0 Then
Err = 0
Set WK = Workbooks.Open(Chemin & NomFichier)
End If

'Détermination des clients recherchés sur les 3 onglets
NomClient = Application.InputBox(prompt:= _
"Identifiez le nom du client", Type:=2)
'Si vous avez cliquer sur le bouton annulé de la fenêtre
If NomClient = "False" Then
MsgBox "Vous avez annulé l'opération."
Exit Sub
End If
'Si vous avez fermé la fenêtre par OK sans rien inscrire
If NomClient = "" Then
MsgBox "Aucun client identifié. Opération annulée."
Exit Sub
End If

'La colonne où se retrouve la liste des clients
Col = 18

'Nom Des onglets des feuilles à traiter pour le nom du client
Arr = Array("Sheet1", "Sheet2", "Sheet3")

For Each Elt In Arr
With WK.Worksheets(Elt)
'Trouve la dernière ligne occupée de la feuille
DerLig = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

'Trouve la dernière colonne occupée de la feuille
DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

'délimitation de la plage occupée de la feuille
'affectée à une variable objet Range
Set Rg = .Range("A1", .Cells(DerLig, DerCol))
End With

'Utilisation de la Variable objet Rg pour effectuer
'un filtre élaboré ou avancé sur la colonne 18 OU R:R
With Rg
.AutoFilter Field:=Col, Criteria1:=NomClient
'Détermination de la plage à copier
If Application.Subtotal(3, Worksheets(Elt).Columns(Col)) - 1 > 0 Then
Set Rg1 = Rg.Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible)
'Nom Feuille à adapter où le résultat sera affiché.
With ThisWorkbook.Worksheets("Sheet1")
'Copie la première ligne - Les étiquettes de colonnes
Rg(1).EntireRow.Copy .Range("A1")

'Déterminer la ligne où copier les enregistrements
LastRow = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1

'Copier la plage résultant du filtre
Rg1.Copy .Range("A" & LastRow)
End With
End If
'Enlève le filtre sur la plage
.AutoFilter
End With
Next
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

merci ca marche super bien

"michdenis" <michdenis@hotmail.com> a écrit dans le message de news:
i7crpd$8bk$1@speranza.aioe.org...

C'est la même procédure mais j'ai pris soin de désactiver certains
éléments lors de l'exécution de la macro.

Sub test()

Dim Rg As Range, NomClient As Variant
Dim Arr(), Elt As Variant, LastRow As Long
Dim DerLig As Long, DerCol As Integer
Dim Rg1 As Range, Col As Integer, WK As Workbook
Dim NomFichier As String, Chemin As String
Dim ModCalcul As String

ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

'Chemin où se retrouve le fichier
Chemin = "c:UsersDMDocuments"
'Nom du fichier
NomFichier = "Classeur1.xls"

'Vérification que le fichier existe...
If Dir(MonChemin & Fichier) = "" Then
MsgBox "Fichier non trouvé."
Exit Sub
End If

'ouverture du fichier où sont les 3 feuilles de données
'Chemin et nom de fichier à spécifier
On Error Resume Next
'Si le fichier est ouvert :
Set WK = Fichier
If Err <> 0 Then
Err = 0
Set WK = Workbooks.Open(Chemin & NomFichier)
End If

'Détermination des clients recherchés sur les 3 onglets
NomClient = Application.InputBox(prompt:= _
"Identifiez le nom du client", Type:=2)
'Si vous avez cliquer sur le bouton annulé de la fenêtre
If NomClient = "False" Then
MsgBox "Vous avez annulé l'opération."
Exit Sub
End If
'Si vous avez fermé la fenêtre par OK sans rien inscrire
If NomClient = "" Then
MsgBox "Aucun client identifié. Opération annulée."
Exit Sub
End If

'La colonne où se retrouve la liste des clients
Col = 18

'Nom Des onglets des feuilles à traiter pour le nom du client
Arr = Array("Sheet1", "Sheet2", "Sheet3")

For Each Elt In Arr
With WK.Worksheets(Elt)
'Trouve la dernière ligne occupée de la feuille
DerLig = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

'Trouve la dernière colonne occupée de la feuille
DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

'délimitation de la plage occupée de la feuille
'affectée à une variable objet Range
Set Rg = .Range("A1", .Cells(DerLig, DerCol))
End With

'Utilisation de la Variable objet Rg pour effectuer
'un filtre élaboré ou avancé sur la colonne 18 OU R:R
With Rg
.AutoFilter Field:=Col, Criteria1:=NomClient
'Détermination de la plage à copier
If Application.Subtotal(3, Worksheets(Elt).Columns(Col)) - 1 > 0
Then
Set Rg1 = Rg.Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible)
'Nom Feuille à adapter où le résultat sera affiché.
With ThisWorkbook.Worksheets("Sheet1")
'Copie la première ligne - Les étiquettes de colonnes
Rg(1).EntireRow.Copy .Range("A1")

'Déterminer la ligne où copier les enregistrements
LastRow = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1

'Copier la plage résultant du filtre
Rg1.Copy .Range("A" & LastRow)
End With
End If
'Enlève le filtre sur la plage
.AutoFilter
End With
Next
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub