MACRO - Copier un tableau avec plusieurs critères

S

Sofy16

XLDnaute Nouveau
Bonjour à tous,

Je vous explique mon problème :
J'ai un tableau dans un onglet "Questions". J'aimerais copier, à partir d'une macro, automatiquement, ce tableau dans un onglet "Questionnaire" en fonction de plusieurs critères :
- colonne B = Principal / Detailed
- Colonne C = Key / Others
- Colonne M = Y / N

J'arrive à copier mon tableau lorsqu'il n'y a qu'un seul critère (fichier ci-joint), mais je n'arrive pas à adapter mon code lorsque j'ai besoin de prendre en compte plusieurs critères.
J'aimerais avoir 4 choix au final, détaillés dans le fichier joint. En fait, une fois que je saurais avoir deux critères différents, je devrait pouvoir en ajouter autant que je veux.

https://www.dropbox.com/s/46sdza1qd3bjmyx/Exemple_Tableau_Critère.xls?dl=0

Merci beaucoup pour votre aide !
 
Trier par date Trier par votes
don_pets

don_pets

XLDnaute Occasionnel
Re : MACRO - Copier un tableau avec plusieurs critères

'llo,

J'aimerais être sur de bien comprendre ^^. Pour dire, je ne comprends pas véritablement ta demande et surtout ce que tu veux faire.
Peux tu me détailler un peu ces histoires de critères, colonnes et dans quelles conditions tu colles ou décolles.
 
Vote positif 0 Vote négatif
S

Sofy16

XLDnaute Nouveau
Re : MACRO - Copier un tableau avec plusieurs critères

Alors, oui je comprends que ce ne soit pas très clair...

J'ai un tableau de 60 questions environs. Avec des questions "key", des questions "others" (colonne C) en catégorie "Principal" (colonne B) et des questions "detailed" (colonne B) rattachées à l'une ou l'autre des questions précédentes.
J'aimerais pouvoir copier ce tableau dans un nouvel onglet selon que je choisi d'avoir uniquement les questions "key" ou "others" ou "key" + "detailed" etc. Et j'aimerais pouvoir réaliser cela à partir d'une macro, de manière automatique donc sans avoir à aller utiliser les filtres sur le tableau total.
Pour l'instant, j'arrive à copier mon tableau en ne prenant qu'un seul critère en compte, avec la macro suivante :

Sub Bouton1064_Cliquer()

Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long

Sheets("First").Activate 'feuille de destination

Col = "M" ' colonne données non vides à tester'
NumLig = 6 'alors là ca doit etre le N° de la 1er ligne de données en comptant la ligne 1 = 0 .... ? '
With Sheets("Questions") ' feuille source'
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 6 To NbrLig 'n° de la 1ere ligne de données'
If .Cells(Lig, Col).Value <> "N" Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Sheets("First").Cells(NumLig, 1).Insert Shift:=xlDown
'ici pour insérer ou .Paste pour coller'
End If
Next
End With


End Sub

Dans cette macro, j'ai (en gros) si la colonne M = "Y" alors je copie la ligne et la colle dans l'onglet "Questionnaire".
Mais je ne sais pas comment intégrer plusieurs critères, ou conditions, dans cette macro.
J'aimerais par exemple pouvoir dire : si la colonne M = Y ET si la colonne B = "Principal" alors je copie la ligne et la colle.
 
Vote positif 0 Vote négatif
pierrejean

pierrejean

XLDnaute Barbatruc
Re : MACRO - Copier un tableau avec plusieurs critères

Bonjour à tous

En supposant avoir compris !!!
 

Pièces jointes

  • Exemple_Tableau_Critère.xls
    410 KB · Affichages: 37
  • Exemple_Tableau_Critère.xls
    410 KB · Affichages: 33
  • Exemple_Tableau_Critère.xls
    410 KB · Affichages: 40
Vote positif 0 Vote négatif
S

Sofy16

XLDnaute Nouveau
Re : MACRO - Copier un tableau avec plusieurs critères

Bonjour Pierre Jean,

Le résultat est super !
Pourriez-vous s'il vous plait m'indiquer dans votre code où se situe les critères ? Afin que je puisse, si possible, en ajouter d'autres à ma guise. Est-ce ce que j'ai mis en gras ci-dessous ?

De plus, est-il possible de réaliser plusieurs sélections, c'est à dire d'insérer la nouvelle sélection en dessous de la précédente ? Sans effacer la sélection précédente. Je pense que cela se trouve sur ce que j'ai mis en rouge, est-cela ?

Merci beaucoup !

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
ActiveSheet.Cells = ""
ActiveSheet.Cells.ClearFormats
ligne = 2

tablo = Sheets("Questions").Range("A5:M" & Sheets("Questions").Range("A" & Rows.Count).End(xlUp).Row)
For n = LBound(tablo, 1) To UBound(tablo, 1)
If (tablo(n, 2) = ComboBox1 Or ComboBox1 = "") And (tablo(n, 3) = ComboBox2 Or ComboBox2 = "") And (tablo(n, 13) = ComboBox3 Or ComboBox3 = "") Then
For m = LBound(tablo, 2) To UBound(tablo, 2)
Cells(ligne, m) = tablo(n, m)
Next
ligne = ligne + 1
End If
Next
If Range("A" & Rows.Count).End(xlUp).Row >= 2 Then Range("A2:M" & Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = xlContinuous
Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
tablo = Sheets("Questions").Range("A5:M" & Sheets("Questions").Range("A" & Rows.Count).End(xlUp).Row)
Set dico1 = CreateObject("Scripting.dictionary")
Set dico2 = CreateObject("Scripting.dictionary")
Set dico3 = CreateObject("Scripting.dictionary")
For n = LBound(tablo, 1) To UBound(tablo, 1)
x = tablo(n, 2)
dico1(x) = x
x = tablo(n, 3)
dico2(x) = x
x = tablo(n, 13)
dico3(x) = x
Next
Me.ComboBox1.List = dico1.keys
Me.ComboBox2.List = dico2.keys
Me.ComboBox3.List = dico3.keys
End Sub
 
Vote positif 0 Vote négatif
S

Sofy16

XLDnaute Nouveau
Re : MACRO - Copier un tableau avec plusieurs critères

Oui c'est cela, mais il est vrai que la solution de Pierrejean est également très bien (mieux même, cela fait plus "pro" ^^)

En fait, mon problème est surtout que je ne sais pas comment faire pour pouvoir sélectionner plusieurs critères sur mon tableau
 
Vote positif 0 Vote négatif
don_pets

don_pets

XLDnaute Occasionnel
Re : MACRO - Copier un tableau avec plusieurs critères

Salut PierreJean,

Dans la continuité de ce que j'écrivais un peu plus haut, (et si toutefois j'ai bien assimilé ton besoin), voila le code que le pondrais par exemple :

(Critère "principal"):

Code: 
    ' Critère principal

Sheets("questionnaire").Activate
Sheets("questionnaire").Range("a:Z").Select
Selection.ClearContents

Sheets("Questions").Activate
Selection.AutoFilter Field:=2, Criteria1:="Principal"

Sheets("Questions").Range("a3").Select
Selection.CurrentRegion.Select
Selection.Copy

Sheets("questionnaire").Activate
Sheets("questionnaire").Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
 
Vote positif 0 Vote négatif
S

Sofy16

XLDnaute Nouveau
Re : MACRO - Copier un tableau avec plusieurs critères

Cela fonctionne également très bien ! Merci !

Est-ce que je peux ajouter mes différents critères sous la ligne :
Selection.AutoFilter Field:=2, Criteria1:="Principal"

Et comment faire pour que mes différentes sélections se collent les une en dessous des autres et non pas à la place de l'autre ?
 
Vote positif 0 Vote négatif
don_pets

don_pets

XLDnaute Occasionnel
Re : MACRO - Copier un tableau avec plusieurs critères

Alors, je suis parti dans l'idée de faire un bouton par critère, donc par exemple si tu voulais faire la même chose mais pour le critèreb key de la colonne c, ça donnerait :
Code: 
Sheets("questionnaire").Activate
Sheets("questionnaire").Range("a:Z").Select
Selection.ClearContents

Sheets("Questions").Activate
Selection.AutoFilter Field:=3, Criteria1:="key"

Sheets("Questions").Range("a3").Select
Selection.CurrentRegion.Select
Selection.Copy

Sheets("questionnaire").Activate
Sheets("questionnaire").Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Ensuite si tu veux que cela ce colle à la suite, il te faut remplacer le dernier bout de code par :

Code: 
Sheets("questionnaire").Activate
Sheets("questionnaire").Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

par contre il te faut enlever la première partie
Code: 
Sheets("questionnaire").Activate
Sheets("questionnaire").Range("a:Z").Select
Selection.ClearContents
 
Vote positif 0 Vote négatif
S

Sofy16

XLDnaute Nouveau
Re : MACRO - Copier un tableau avec plusieurs critères

Alors oui effectivement, on pourrais faire un bouton par critère, et les ajouter les uns en dessous des autres.
Mais sinon, en faisant comme ci-dessous, j'arrive à sélectionner à la fois le critère "Principal" et le critère "Key". Cependant, je n'arrive pas à sélectionner deux mêmes critères qui font partie de la même colonne.

Code: 
Sheets("Questions").Activate
Selection.AutoFilter Field:=2, Criteria1:="Principal"
Selection.AutoFilter Field:=3, Criteria1:="Key"


Ensuite, pour votre code pour coller à la suite, j'ai le message suivant qui s'affiche :
La méthode PasteSpecial de la classe Range a échoué
Avec surligné en jaune la partie du code suivante :

Code: 
Selection.PasteSpecial Paste:=xlPasteAll, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
 
Vote positif 0 Vote négatif
don_pets

don_pets

XLDnaute Occasionnel
Re : MACRO - Copier un tableau avec plusieurs critères

Si tu veux deux critères de la même colonne (par exemple key et others de la colonne c) il te suffit de transformer
Code: 
Sheets("Questions").Activate
Selection.AutoFilter Field:=3, Criteria1:="key"
par
Code: 
Selection.AutoFilter Field:=3, Criteria1:=Array( _
        "key", "Others"), _
        Operator:=xlFilterValues
 
Vote positif 0 Vote négatif
don_pets

don_pets

XLDnaute Occasionnel
Re : MACRO - Copier un tableau avec plusieurs critères

Tiens voici tout le code pour coller à la suite de la dernière ligne de l'onglet questionnaire, en prenant les critères key et others
Code: 
Private Sub CommandButton1_Click()

Sheets("Questions").Activate

Selection.AutoFilter Field:=3, Criteria1:=Array( _
        "key", "Others"), _
        Operator:=xlFilterValues

Sheets("Questions").Range("a3").Select
Selection.CurrentRegion.Select
Selection.Copy


Sheets("questionnaire").Activate
Sheets("questionnaire").Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

End Sub
 
Vote positif 0 Vote négatif
S

Sofy16

XLDnaute Nouveau
Re : MACRO - Copier un tableau avec plusieurs critères

C'est super !

J'ai une dernière question... Je n'arrive pas à mettre ce code en double, afin de sélectionner à la fois 2 critères sur la colonne B et 2 critères sur la colonne C. Mais cela n'est peut être pas possible ?

Code: 
Selection.AutoFilter field:=3, Criteria1:=Array( _
        "key", "Others", "D"), _
        Operator:=xlFilterValues

Sinon, le copier/coller à la suite fonctionne parfaitement merci :)
 
Vote positif 0 Vote négatif
don_pets

don_pets

XLDnaute Occasionnel
Re : MACRO - Copier un tableau avec plusieurs critères

essaie ça :
Code: 
Selection.AutoFilter Field:=2, Criteria1:=Array( _
        "Principal", "Detailed"), _
        Operator:=xlFilterValues

Selection.AutoFilter Field:=3, Criteria1:=Array( _
        "key", "Others"), _
        Operator:=xlFilterValues
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Résolu(e)
Microsoft 365 recherche valeur dans plusieurs onglets plusieurs critères
Réponses
2
Affichages
136
c.azzopardi@free.fr
C
P
  • Résolu(e)
Autres Choix selon plusieurs critères
Réponses
2
Affichages
150
Pascal22100
P
W
  • Question
Microsoft 365 Formule combinant multiples critères et OU
Réponses
4
Affichages
207
Wiil85
W
P
  • Résolu(e)
Microsoft 365 Une Recherche spéciale avec 2 critères
Réponses
7
Affichages
340
DJunqueira
D
J
  • Question
Microsoft 365 Recherche puis validation en fonction de plusieurs critères
Réponses
2
Affichages
197
julien1982
J
C
  • Question
XL 2019 vba excel : masquer un tableau word
Réponses
9
Affichages
368
CBX
C
R
  • Résolu(e)
XL 2019 Recherche valeur (Critère date et ID) et copier valeur dans tableau dans la cellule correspondante
3 4 5
Réponses
66
Affichages
2 K
Rabeto
R
H
  • Résolu(e)
Autres copier des colonnes de tableau dans un autre onglet
Réponses
8
Affichages
378
hervoul
H
Eric 888
  • Résolu(e)
Microsoft 365 repartir des personnes en deux groupes équilibrés selon plusieurs critères
Réponses
7
Affichages
217
Eric 888
Eric 888
Chubby
  • Question
XL 2016 Trouver une valeur selon 3 critères
Réponses
3
Affichages
216
Chubby
Chubby

Membres actuellement en ligne

14 membres et 123 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 323
Messages
2 087 301
Membres
103 512
dernier inscrit
sisi235