Adapter code classeur pour feuilles

2susy

XLDnaute Junior
Bonjour à tous,

j'ai trouvé un super code me permettant de dispatcher les donneés d'une bdd en créant plusieurs classeurs. Seulement, ça fait longtemps que je n'ai pas pratiqué vba et j'avoue que je suis perdue quand il s'agit d'adapter ce code à la création de feuilles (ou onglets) et non pas de classeurs par pays.
Le voici ci-dessous :
Crée un classeur par pays
Code:
Sub CreeClasseurs()
  Application.DisplayAlerts = False
  [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
       ActiveWorkbook.SaveAs Filename:=c
       ActiveWorkbook.Close
       ActiveSheet.Delete
       Sheets("BD2").Select
    Next c
End Sub
Merci pour votre aide !
 

Staple1600

XLDnaute Barbatruc
Re : Adapter code classeur pour feuilles

Bonjour


Essaie ainsi

Code:
Sub CreeClasseursA()
  Application.DisplayAlerts = False
  [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.Name = c
    [COLOR=Blue]Sheets("BD2").Select[/COLOR]
    Next c
End Sub
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Adapter code classeur pour feuilles

Re


J'ai édité mon précédent message
Rajoute ce qui est en bleu (pour voir ce qui se passe avec le code ainsi modifié)


PS: si tu joignais un petit fichier exemple, on pourrait tester directement.
 

Discussions similaires

Réponses
1
Affichages
711

Statistiques des forums

Discussions
312 215
Messages
2 086 318
Membres
103 176
dernier inscrit
jean.yvesjean.yves