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
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
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

V
  • Résolu(e)
XL 2019 fonction recherchev
Réponses
9
Affichages
279
DJunqueira
D
chris6999
  • Question
Microsoft 365 MACRO VBA - Extraire des listes à partir d'une boucle
Réponses
5
Affichages
202
chris6999
chris6999
T
  • Résolu(e)
Formule pour extraire des valeurs uniques
Réponses
5
Affichages
181
mapomme
mapomme
B
  • Question
XL 2019 Exportation Feuille PDF VBA
Réponses
2
Affichages
249
kiki29
kiki29
B
  • Résolu(e)
Microsoft 365 extraction de données vba
2 3 4
Réponses
45
Affichages
1 K
chris
chris
cabsen
  • Question
XL 2019 Extraire toutes les données d'une liste en fonction d'un critère
Réponses
2
Affichages
369
cabsen
cabsen
L
  • Question
XL 2021 recherche de valeurs
Réponses
3
Affichages
147
sylvanu
sylvanu
C
  • Question
Microsoft 365 Extraction de datas dans des fichiers pdf
Réponses
2
Affichages
227
kiki29
kiki29
J
  • Question
Microsoft 365 extraction VBA avec formule si
Réponses
10
Affichages
334
Phil69970
Phil69970
A
  • Résolu(e)
XL 2013 filtre avancé
2
Réponses
17
Affichages
330
Appo1985
A

Membres actuellement en ligne

15 membres et 116 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 207
Messages
2 086 230
Membres
103 160
dernier inscrit
Torto