Extraire des lignes

Cousinhub à dit:

Re-,
Donc, les macros, tu ne peux pas...
C'est pas grave, tu as ce que tu voulais, c'est le principal
Bonne soirée

Cliquez pour agrandir...

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

mapomme à dit:

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

Cliquez pour agrandir...

matthieu2701 à dit:

Bonjour @mapomme ,

Cela fonctionne parfaitement. Merci

Est-il possible de rajouter une colonne, dans les nouvelles feuilles, avec un commentaire après la dernière colonne qui sera différent si c'est "Fabricant1" ou "Fabricant2et3" ?

Ensuite, j'aimerais compléter la "Feuil3" avec :

- en colonne "A" : le texte de la colonne "E" de la feuille des feuilles "Fabricant 1,2et3"

- en colonne "I" : le texte de la colonne "Q" de la feuille des feuilles "Fabricant 1,2et3"

- en colonne "K" : le texte de la colonne "R" de la feuille des feuilles "Fabricant 1,2et3"

- en colonne "M" : le texte de la colonne "K" de la feuille des feuilles "Fabricant 1,2et3"

- en colonne "P" : le texte de la colonne qui sera créé après la dernière colonne de la feuille des feuilles "Fabricant 1,2et3"

Merci par avance

J'espère que j'ai été assez clair.

Merci par avance.

Cliquez pour agrandir...

mapomme à dit:

Re ,

Je ne comprends pas l'attendu.

Quels commentaires mettre ? Peux-tu renvoyer un fichier avec les résultats désirés ?

Cliquez pour agrandir...

matthieu2701 à dit:

Non ce n’est pas ça. Je sais qu’il faut activer. Après avoir activer j’ai un message rouge m’indiquant : contenu bloqué : les macros ont été désactivées car la source de ce fichier n’est pas approuvée

Cliquez pour agrandir...

mapomme à dit:

Re,

D'accord. J'ai modifié le code dans module1 pour tenir compte de ta demande.

Tout en haut du code, il y a deux lignes commençant par "Const".
Ce sont les commentaires par défaut à mettre dans chaque colonne commentaire.
Pour ne rien mettre dans une colonne de commentaire, mettre la constante à vide :
Exemple : Const CommentDefautFab1 = ""

Cliquez pour agrandir...

patty58 à dit:

Sa demande finale n'est pas claire.. Donc, bon courage à tous pour les devinettes

Cliquez pour agrandir...

mapomme à dit:

Bonsoir @patty58 ,

J'avoue que je m'y perds aussi.

Au départ, on extrait selon Fabricant1 et les autres fabricants selon un format donné.

Ensuite on rajoute une colonne aux extractions.

Ensuite on voit la feuille source qui a été modifiée pour y rajouter des commentaires.

Puis on voit apparaitre une feuille "Feuil3" et une feuille "Non accessible" dont les critères de filtre n'ont rien à voir avec le champ Fabricant et dont les champs n'ont rien à voir avec la première demande.

Puis quoi encore ?

Regarde la pièce jointe 1185008

Cliquez pour agrandir...