Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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

Bonjour
Puis-je avoir le code de la macro car mon entreprise bloque la macro à l'ouverture du fichier stp ?
refléchiquestion gif.gif
 
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

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

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
Merci
 
Les macros je peux. Je comprends pourquoi c’est bloqué alors. C’est par rapport à power query
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
 
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
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é.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
18
Affichages
332
Réponses
75
Affichages
1 K
Retour