Création classeur suivant filtre

reve24 · 21 Octobre 2014

Bonjour

En partant du fichier de http://boisgontierjacques.free.fr/fichiers/Onglets/CreeClasseursPays.xls

Je souhaiterais pouvoir créer des classeurs suivant filtre avec en nom d'onglet Feuil1 et nom de classeur le nom du filtre .
Ci après ma modif
Sub CreeClasseurs()
Application.DisplayAlerts = False
[A1:I10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[U1], Unique:=True
For Each c In Range("U2", Range("U65000").End(xlUp))
Range("U2") = c
Sheets.Add
ChDir "C:\Documents and Settings\Blabla\Bureau\Inventaire\Export"
Sheets("BD2").[A1:I10000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("BD2").[U1:U2], CopyToRange:=[A1], Unique:=False
ActiveSheet.Copy
ActiveSheet.Name = "Feuil1"
ActiveWorkbook.SaveAs Filename:=c
Application.Dialogs(xlDialogSaveAs).Show
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets("BD2").Select
Next c
End Sub

Seulement il me demande toujours la confirmation de l enregistrement , ceci est possible si 3 classeurs mais si j ai 60 classeurs cela peut devenir penible

Quelqu un peut il m aider ?

Merci d avance

Paritec · 23 Octobre 2014

Re : Création classeur suivant filtre

Bonjour Reve24 le forum
bon alors avec un filtre sur la colonne G et une colonne G vide tu m'expliqueras !!!!!!
bref pour éviter les messages, à tester
a+
Papou

Code:

Sub CreeClasseurs()
  [A1:D10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[g1], Unique:=True
  For Each c In Range("G2", Range("G65000").End(xlUp))
     Range("G2") = c
     Sheets.Add
     Sheets("BD2").[A1:D10000].AdvancedFilter Action:=xlFilterCopy, _
         CriteriaRange:=Sheets("BD2").[G1:G2], CopyToRange:=[A1], Unique:=False
       ActiveSheet.Copy
       ActiveSheet.Name = c
       Application.DisplayAlerts = 0
       ActiveWorkbook.SaveAs Filename:=c
       ActiveWorkbook.Close
       ActiveSheet.Delete
       Application.DisplayAlerts = 1
       Sheets("BD2").Select
    Next c
End Sub

Création classeur suivant filtre

reve24

XLDnaute Occasionnel

Pièces jointes

Paritec

XLDnaute Barbatruc

Discussions similaires