création de plusieur fichier Excel automatique

[Tchip112]

Bonjour , Je suis nouveau sur le Forum . Je me suis insrit car on m en a dit bcp de bien .

Actuellement j ai un petit problème , En effet, J'ai un fichier Excel. Dans ce fichier Excel figure 250 fournisseurs avec des éléments liés à ce fournisseur.

J’aimerais avoir une solution pour pouvoir créer automatique un fichier Excel par fournisseur (case jaune B) avec comme nom de fichier le nom du fournisseur et toute les informations figurant dans les autres colonnes et lignes doivent figurer sur le fichier. Je dois effectuer ce travail 1 fois par mois et sur une quinzaine de fichier. Si je peux automatiser ce travail ca m arrangerait.
J ai réduit volontairement le nombre de colonne et le nombre de fournisseur. Ce fichier test Excel ne comporte que 10 fournisseurs Alors qu’en réalité ca va jusqu’a 250
Merci pour votre aide.

 

[BOISGONTIER]

Re : création de plusieur fichier Excel automatique

Bonjour,

Voir PJ

Sub CreeClasseurs()
  Application.DisplayAlerts = False
  [A1:I10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[k1], Unique:=True
  For Each c In Range("k2", Range("k65000").End(xlUp))
    Range("k2") = c
    Sheets.Add
    Sheets("test").[A1:I10000].AdvancedFilter Action:=xlFilterCopy, _
       CriteriaRange:=Sheets("test").[k1:k2], CopyToRange:=[A1], Unique:=False
    ActiveSheet.Copy
    ActiveSheet.Name = nomOngletValide(c)
    ActiveWorkbook.SaveAs Filename:=nomOngletValide(c)
    ActiveWorkbook.Close
    ActiveSheet.Delete
    Sheets("test").Select
  Next c
End Sub

Function nomOngletValide(nom)
  For i = 1 To Len(nom)
    x = Mid(nom, i, 1)
   If x Like "[A-Z]" Or x Like "[0-9]" Then
      temp = temp & x
   End If
  Next i
  nomOngletValide = temp
End Function

JB
Formation Excel VBA JB

 

[kjin]

Re : création de plusieur fichier Excel automatique

Voir message suivant
A+
kjin

 

[Catrice]

Re : création de plusieur fichier Excel automatique

Bonjour à tous, bonjour JB,

comme j'avais commencé, je le mets qd meme.
Voir le fichier joint

Je ne gere pas les "*" pour les noms de fichiers.
Je les ai enlevés de la base.
S'il faut les gerer pas de pb ...

Sub Test()
Set TempoSheet = Sheets.Add
With ThisWorkbook.Sheets("test")
.Range("B1:" & .Range("B65536").End(xlUp).Address).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=TempoSheet.Range("A1"), Unique:=True
Application.DisplayAlerts = False 'Laisser cette ligne si on veut ecraser les fichiers existants
For i = 2 To TempoSheet.Range("A65536").End(xlUp).Row
Workbooks.Add
.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=TempoSheet.Range("A1:A2"), CopyToRange:=ActiveWorkbook.Sheets(1).Range("A1")
ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & TempoSheet.Range("A2").Value
TempoSheet.Range("A2").EntireRow.Delete
Next
Application.DisplayAlerts = False
TempoSheet.Delete
Application.DisplayAlerts = True
End With
End Sub

 

[kjin]

Re : création de plusieur fichier Excel automatique

Re,bonjour JB, Catrice,
Version de JB bien plus rapide que la mienne
Y a pas photo 😉
A+
kjin

 

[Catrice]

Re : création de plusieur fichier Excel automatique

Re,

Sauf erreur je crois que Tchip112 veut traiter le code de la colonne B ...
..... un fichier Excel par fournisseur (case jaune B) avec comme .....

 

[Tchip112]

Re : création de plusieur fichier Excel automatique

🙂Bonsoir a tous je viens d essayer vos reponses et je tiens à vous remercier tous !!!! C'est exactement ce que je voulais, Je suis vraiment agréablement supris . c'est vraiment cool !
Un grand merci à Catrice ;Kjin;Boisgontier;

Merci et bonnes Fetes !!🙂