Extraire des lignes

M

matthieu2701

XLDnaute Occasionnel
Bonjour à tous,

Je viens vers vous car je souhaite extraire, sur une nouvelle feuille, les lignes qui contiennent une donnée d'une colonne.

Dans mon fichier, j'aimerais extraire les lignes dont la colonne P contient "Fabricant1" dans une feuille et "Fabricant2" + "Fabricant3" dans une autre feuille.

Je vous joint le fichier.

Merci par avance
 

Pièces jointes

  • Test.xlsm
    595.5 KB · Affichages: 10
Trier par date Trier par votes
R@chid

R@chid

XLDnaute Barbatruc
Supporter XLD
Bonjour,
Merci de bien vouloir préciser la version d'Excel utilisée.
Avec PQ, en cas d'ajout de données dans le tableau source, il suffit d 'actualiser les requêtes des deux autres tableaux.

Cordialement,
 

Pièces jointes

  • mathieu2701_PQ_ExtractionFabricants.zip
    973.9 KB · Affichages: 6
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
Bonjour
Puis-je avoir le code de la macro car mon entreprise bloque la macro à l'ouverture du fichier stp ?
Cliquez pour agrandir...
refléchiquestion gif.gif
 
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

Par VBA avec le texte d'une macro dans un module :
VB: 
Sub ventiler()
Dim ts As ListObject, i&, j&, i1&, i2&, n&, t, t1, t2
   Application.ScreenUpdating = False
   Set ts = Worksheets("BDD").Range("a1").ListObject: n = ts.ListColumns.Count
   On Error Resume Next
   i = 0: i = Worksheets("Fabricant1").Range("a1").CurrentRegion.Clear
   If i = 0 Then Worksheets.Add: ActiveSheet.Name = "Fabricant1"
   Worksheets("Fabricant1").Columns(1).Resize(, n).Clear
   i = 0: i = Worksheets("Fabricant-autres").Index
   On Error GoTo 0
   If i = 0 Then Worksheets.Add: ActiveSheet.Name = "Fabricant-autres"
   Worksheets("Fabricant-autres").Columns(1).Resize(, n).Clear
   t = ts.Range: t1 = ts.Range: t2 = ts.Range: i1 = 1: i2 = 1
   For i = 2 To UBound(t)
      If t(i, 16) = "Fabricant1" Then
         i1 = i1 + 1
         For j = 1 To n: t1(i1, j) = t(i, j): Next
      Else
         i2 = i2 + 1
         For j = 1 To n: t2(i2, j) = t(i, j): Next
      End If
   Next i
    Worksheets("Fabricant1").Range("a1").Resize(i1, n) = t1
    Worksheets("Fabricant-autres").Range("a1").Resize(i2, n) = t2
End Sub
 

Pièces jointes

  • matthieu2701- fabricant1 et les autres- v1.xlsm
    600 KB · Affichages: 4
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

Une version qui présente les résultats sous forme de tableaux structurés de noms "tsFab1" et "tsFabN".
VB: 
Sub ventiler()
Dim ts As ListObject, i&, j&, i1&, i2&, n&, t, t1, t2
   Application.ScreenUpdating = False
   Set ts = Worksheets("BDD").Range("a1").ListObject: n = ts.ListColumns.Count
   On Error Resume Next
   i = 0: i = Worksheets("Fabricant1").Range("a1").CurrentRegion.Clear
   If i = 0 Then Worksheets.Add: ActiveSheet.Name = "Fabricant1"
   Worksheets("Fabricant1").Columns(1).Resize(, n).Clear
   i = 0: i = Worksheets("Fabricant-autres").Index
   On Error GoTo 0
   If i = 0 Then Worksheets.Add: ActiveSheet.Name = "Fabricant-autres"
   Worksheets("Fabricant-autres").Columns(1).Resize(, n).Clear
   t = ts.Range: t1 = ts.Range: t2 = ts.Range: i1 = 1: i2 = 1
   For i = 2 To UBound(t)
      If t(i, 16) = "Fabricant1" Then
         i1 = i1 + 1
         For j = 1 To n: t1(i1, j) = t(i, j): Next
      Else
         i2 = i2 + 1
         For j = 1 To n: t2(i2, j) = t(i, j): Next
      End If
   Next i
   With Worksheets("Fabricant1")
      .Range("a1").Resize(i1, n) = t1
      .ListObjects.Add(xlSrcRange, .Range("a1").Resize(i1, n), , xlYes).Name = "tsFab1"
      .ListObjects("tsFab1").TableStyle = "TableStyleMedium7"
   End With
   With Worksheets("Fabricant-autres")
      .Range("a1").Resize(i2, n) = t2
      .ListObjects.Add(xlSrcRange, .Range("a1").Resize(i2, n), , xlYes).Name = "tsFabN"
      .ListObjects("tsFabN").TableStyle = "TableStyleMedium5"
   End With
End Sub
 

Pièces jointes

  • matthieu2701- fabricant1 et les autres- v2.xlsm
    599.1 KB · Affichages: 7
Vote positif 0 Vote négatif
M

matthieu2701

XLDnaute Occasionnel
mapomme à dit:
Re,

Par VBA avec le texte d'une macro dans un module :
VB: 
Sub ventiler()
Dim ts As ListObject, i&, j&, i1&, i2&, n&, t, t1, t2
   Application.ScreenUpdating = False
   Set ts = Worksheets("BDD").Range("a1").ListObject: n = ts.ListColumns.Count
   On Error Resume Next
   i = 0: i = Worksheets("Fabricant1").Range("a1").CurrentRegion.Clear
   If i = 0 Then Worksheets.Add: ActiveSheet.Name = "Fabricant1"
   Worksheets("Fabricant1").Columns(1).Resize(, n).Clear
   i = 0: i = Worksheets("Fabricant-autres").Index
   On Error GoTo 0
   If i = 0 Then Worksheets.Add: ActiveSheet.Name = "Fabricant-autres"
   Worksheets("Fabricant-autres").Columns(1).Resize(, n).Clear
   t = ts.Range: t1 = ts.Range: t2 = ts.Range: i1 = 1: i2 = 1
   For i = 2 To UBound(t)
      If t(i, 16) = "Fabricant1" Then
         i1 = i1 + 1
         For j = 1 To n: t1(i1, j) = t(i, j): Next
      Else
         i2 = i2 + 1
         For j = 1 To n: t2(i2, j) = t(i, j): Next
      End If
   Next i
    Worksheets("Fabricant1").Range("a1").Resize(i1, n) = t1
    Worksheets("Fabricant-autres").Range("a1").Resize(i2, n) = t2
End Sub
Cliquez pour agrandir...
Merci
 
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
matthieu2701 à dit:
Les macros je peux. Je comprends pourquoi c’est bloqué alors. C’est par rapport à power query
Cliquez pour agrandir...
Bonsoir,
Je pense que, soit tu te trompes (et tu ne sais pas ce qu'il se passe), soit ta boîte marche sur la tête...
Autoriser les macros, et suspendre Power Query (si d'ailleurs c'est possible????)
Donc, hypothèse première privilégiée
Et par ailleurs, tu avais également eu une proposition Power Query sur l'autre forum (sans réponse envers le bénévole d'ailleurs...)
Bonne soirée
 
Vote positif 0 Vote négatif
M

matthieu2701

XLDnaute Occasionnel
Cousinhub à dit:
Bonsoir,
Je pense que, soit tu te trompes (et tu ne sais pas ce qu'il se passe), soit ta boîte marche sur la tête...
Autoriser les macros, et suspendre Power Query (si d'ailleurs c'est possible????)
Donc, hypothèse première privilégiée
Et par ailleurs, tu avais également eu une proposition Power Query sur l'autre forum (sans réponse envers le bénévole d'ailleurs...)
Bonne soirée
Cliquez pour agrandir...
Salut, quand j’ouvre le fichier, cela me note un message comme quoi la macro a été bloquée pour une question de sécurité.
 
Vote positif 0 Vote négatif

Discussions similaires

Moi69
  • Résolu(e)
Power Query extraction de caracteres
Réponses
5
Affichages
469
JFL_XLD
J
L
  • Question
XL 2016 extraction lignes tableau et regroupement dans autre tableau
Réponses
5
Affichages
256
Lorenzini
L
C
  • Résolu(e)
XL 2021 Formule mois en lettres 'mmmm' à partir date jj.mm.yyyy
Réponses
8
Affichages
231
djidji59430
djidji59430
C
  • Résolu(e)
Microsoft 365 Problème VBA lors de l'affichage de ligne masquée
2
Réponses
21
Affichages
634
Chris Linefield
C
Moi69
  • Résolu(e)
Power Query extraction de donnees particulieres
Réponses
4
Affichages
395
Moi69
Moi69
V
  • Résolu(e)
XL 2019 fonction recherchev
Réponses
9
Affichages
705
DJunqueira
D
Caninge
  • Question
XL 2019 Extraction de Données dans fichier PDF
Réponses
14
Affichages
466
Caninge
Caninge
Titof06
  • Question
XL 2019 Fichier ".txt" de plus de 2.000.000 de lignes !
5 6 7
Réponses
99
Affichages
4 K
job75
job75
R
  • Résolu(e)
XL 2021 Valeur unique sur plusieurs colonnes
Réponses
6
Affichages
411
Gégé-45550
Gégé-45550
B
  • Question
XL 2013 trier les lignes pour transfert sur autre tableau
Réponses
2
Affichages
203
bruno972
B

Membres actuellement en ligne

8 membres et 126 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
314 862
Messages
2 113 634
Membres
111 927
dernier inscrit
kavelar