Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

macro incluant des filtres automatiques

4 réponses
Avatar
Mirv
Bonjour,

J'essaie sans succes de faire fonctionner une macro incluant des filtres
auto. Je me permets de vous copier le passage qui bug :

Sub SelectDeals()
'
Sheets("contrats").Select
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1").AutoFilter
End If
Range("A1").AutoFilter FIELD:=3, Criteria1:="prenom,nom"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Add
Range("B2").Select
ActiveSheet.Paste

...etc...

le 1er probleme concerne le End If (message indiquant qu'il ne trouve
pas le bloc "If". Pourtant, moi je le vois !!!

2nd probleme : il ne comprend pas le End dans Range(Selection,
Selection.End(xlToRight)).Select

L'aide d'excel et internet ne m'ont pas beaucoup aide...

En vous remerciant pour votre aide,

4 réponses

Avatar
Daniel.C
Bonsoir.

1. Enlève le "end if"; ou tu mets :
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1").AutoFilter
ou tu mets :
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1").AutoFilter
end if

2. Qu'est-ce que tu veux dire par "il ne comprend pas" ? Qu'est-ce que
tu veux faire ?

Daniel

Bonjour,

J'essaie sans succes de faire fonctionner une macro incluant des filtres
auto. Je me permets de vous copier le passage qui bug :

Sub SelectDeals()
'
Sheets("contrats").Select
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1").AutoFilter
End If
Range("A1").AutoFilter FIELD:=3, Criteria1:="prenom,nom"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Add
Range("B2").Select
ActiveSheet.Paste

...etc...

le 1er probleme concerne le End If (message indiquant qu'il ne trouve pas le
bloc "If". Pourtant, moi je le vois !!!

2nd probleme : il ne comprend pas le End dans Range(Selection,
Selection.End(xlToRight)).Select

L'aide d'excel et internet ne m'ont pas beaucoup aide...

En vous remerciant pour votre aide,


Avatar
MichDenis
Bonjour Mirv,

Une idée de ce que ton code pourrait avoir l'air !

'--------------------------------------------
Sub SelectDeals()
Dim Wk As Workbook, Nom
Nom = ActiveWorkbook.Name
Set Wk = Workbooks.Add
With Sheets("contrats")
With Range("A1").CurrentRegion
.AutoFilter FIELD:=3, Criteria1:="prenom,nom"
End With
With .Range("_FilterDataBase")
.SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets(1).Range("A1")
.AutoFilter
End With
End With
Workbooks(Nom).Activate
End Sub
'--------------------------------------------



"Mirv" a écrit dans le message de groupe de discussion :
#1MOR$
Bonjour,

J'essaie sans succes de faire fonctionner une macro incluant des filtres
auto. Je me permets de vous copier le passage qui bug :

Sub SelectDeals()
'
Sheets("contrats").Select
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1").AutoFilter
End If
Range("A1").AutoFilter FIELD:=3, Criteria1:="prenom,nom"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Add
Range("B2").Select
ActiveSheet.Paste

...etc...

le 1er probleme concerne le End If (message indiquant qu'il ne trouve
pas le bloc "If". Pourtant, moi je le vois !!!

2nd probleme : il ne comprend pas le End dans Range(Selection,
Selection.End(xlToRight)).Select

L'aide d'excel et internet ne m'ont pas beaucoup aide...

En vous remerciant pour votre aide,
Avatar
Mirv
Bonsoir,

Merci pour vos reponses rapides !

Le 2nd probleme est lie a cette ligne de code (enregistree par
l'enregistreur de macro) :
Range(Selection, Selection.End(xlToRight)).Select

Lorsque je relance la macro manuellement, le "End" est surligne en gris
avec un message d'erreur...

Je vais tester le code propose par MichDenis et revient vers le forum si
ca plante a nouveau... Merci pour votre aide !
Avatar
Mirv
Merci pour ton aide, je teste cela demain.
Merci,