Microsoft 365 Decoupage BDD en plusieurs fichiers distincts

[Photosol]

Bonjour à vous,

Tout d'abord, je suis désolé de rouvrir ce sujet, j'ai trouvé plein de différentes variantes de ma problématique, mais je n'arrive pas à les compiler pour obtenir le résultat souhaité, alors que cela m'a l'air assez simple sur le principe. J'ai un fichier Excel, que je souhaites découper en plusieurs fichiers Excel, à chaque fois que la référence change dans une colonne souhaitée. Rien d'extraordinaire, cependant je n'arrive pas à parvenir à mes fins.

Voici en PJ mon fichier Base de donnée, que je souhaiterais découper en plusieurs fichiers excel :

- A chaque changement de nom de la colonne I, créer un petit fichier contenant les informations liées à cette référence (environ 70 ref pour 11000 lignes, donc env 70 fichiers à la fin)
- en renommant le fichier avec le contenu suivant : "Listing + "nom contenu dans la colonne I"
- le tout dans le dossier contenant la BDD d'origine.

Est ce que vous avez une solution simple pour intégrer un bouton et mettre une macro dessus qui ferait cela simplement?

Je vous souhaites une excellente journée, et vous remercie d'avance pour votre aide

Yohann

 

[BOISGONTIER]

Bonjour,

Sub CreeClasseurs()
  Set f = Sheets("export_ventes de bouteilles par")
  Application.DisplayAlerts = False
  [M1] = [I1]
  f.[A1:I10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[M1], Unique:=True
  For Each c In Range("M2", Range("M65000").End(xlUp))
     Range("M2") = c
     Sheets.Add
     f.[A1:I20000].AdvancedFilter Action:=xlFilterCopy, _
         CriteriaRange:=f.[M1:M2], CopyToRange:=[A1], Unique:=False
       ActiveSheet.Copy
       tmp = Left(Replace(c, " ", "_"), 31)
       ActiveSheet.Name = tmp
       ActiveWorkbook.SaveAs Filename:=tmp
       ActiveWorkbook.Close
       ActiveSheet.Delete
      f.Select
    Next c
End Sub

Boisgontier

 

[GALOUGALOU]

bonjour photosol bonjour boisgontier bonjour le forum
pour répondre à la demande de photosol le nom prédédé de listing et enregistrement dans le dossier source j'ai repris la macro de boisgontier (j'adore trop bien) pour lui rajouter le chemin

Sub CreeClasseurs()
chemin = ThisWorkbook.Path & "\"
  Set f = Sheets("export_ventes de bouteilles par")
  Application.DisplayAlerts = False
  f.[A1:I10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[M1], Unique:=True
  For Each c In Range("M2", Range("M65000").End(xlUp))
     Range("M2") = c
     Sheets.Add
     f.[A1:I20000].AdvancedFilter Action:=xlFilterCopy, _
         CriteriaRange:=f.[M1:M2], CopyToRange:=[A1], Unique:=False
       ActiveSheet.Copy
       tmp = Left(Replace(c, " ", "_"), 31)
       ActiveSheet.Name = tmp
       ActiveWorkbook.SaveAs Filename:=chemin & "Listing" & "_" & tmp
       ActiveWorkbook.Close
       ActiveSheet.Delete
      f.Select
    Next c
End Sub

cordialement
galougalou

 

[Staple1600]

Bonsoir le fil

GALOUGALOU
Dans ce cas, on peut abréger un chouia, non ?
Ceci suffira
ActiveWorkbook.SaveAs Filename:=chemin & "Listing_" & tmp

 

[GALOUGALOU]

Bonjour le fil

Totalement underscore où l'espace au choix de l'utilisateur personnellement je n'aurais même pas mis listing cela me semble inutile. allez pour rire abregeons, je marche sous la pluie @+

 

[Staple1600]

Re

Euh?
Je voulais juste dire pourquoi
"Listing" & "_" & tmp
quand
"Listing_" & tmp donne le même résulat.

 

[GALOUGALOU]

je suis dans la rue avec mon téléphone et sans lunettes. Pour ma curiosité je regarde ça ce soir mais ta correction est certainement parfaite @+

 

[Staple1600]

Re

C'était d'abord une question
(et non pas une correction)

 

[GALOUGALOU]

Et bien comme ça je ne sais pas je regarde ce soir.

 

[GALOUGALOU]

bonjour le fil
et oui devant l'ordi c'est plus clair.
pour staple1600 c'est tout simplement un manque de logique de ma part. c'est effectivement un chouia plus simple
cordialement
galougalou