Microsoft 365 Decoupage BDD en plusieurs fichiers distincts

Photosol · 29 Février 2020

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 · 29 Février 2020

Bonjour,

VB:

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 · 29 Février 2020

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

Enrichi (BBcode):

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 · 29 Février 2020

Bonsoir le fil

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

GALOUGALOU · 29 Février 2020

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 · 29 Février 2020

Re

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

GALOUGALOU · 29 Février 2020

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 · 29 Février 2020

Re

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

GALOUGALOU · 29 Février 2020

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

GALOUGALOU · 29 Février 2020

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

Microsoft 365 Decoupage BDD en plusieurs fichiers distincts

Photosol

XLDnaute Junior

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

GALOUGALOU

XLDnaute Accro

Staple1600

XLDnaute Barbatruc

GALOUGALOU

XLDnaute Accro

Staple1600

XLDnaute Barbatruc

GALOUGALOU

XLDnaute Accro

Staple1600

XLDnaute Barbatruc

GALOUGALOU

XLDnaute Accro

GALOUGALOU

XLDnaute Accro

Discussions similaires