Repartir des données ds plusieurs classeurs (bis)

[elouahi95]

Bonjour à Tous,

Voici ma demande:

J'ai un onglet ''Portefeuille" qui contient un tableau avec quelques données, la macro actuelle (et au passage je remercie Robert) permet de répartir les données de ce tableau dans 4 onglets... le critère de répartition est très simple c'est la valeur de la colonne ''Domaine'' qui peut avoir 4 valeur:

- Les lignes dont la valeur de la colonne "Domaine" = A vont dans le classeur Domaine A
- Les lignes dont la valeur de la colonne "Domaine" = B vont dans le classeur Domaine B
- Les lignes dont la valeur de la colonne "Domaine" = C vont dans le classeur Domaine C
- Les lignes dont la valeur de la colonne "Domaine" = D vont dans le classeur Domaine D

...aprés quelques essais je voudrais améliorer la macro...

1- lors du 1er lancement de la macro les donner se repartissent bien dans les onglets mais à partir du 2nd lancement les données viennent se rajouter en fin de liste (cumul) ma petite evolution est d’effacer les onglet de destinations à partir de la ligne 2 ou ecraser toutes les données par les nouvelles.

2- Je voudrais selectionner seulement quelques colonnes à reporter (ex: reporter que les colonnes A;B;F,H,I)

Voir pj ça doit etre simple mais comme je suis nul je n'y arrive pas

Merci d'avance

 

[mercant76]

Re : Repartir des données ds plusieurs classeurs (bis)

bonjour,

fichier joint mofidié en fonction de ta demande.

dismoi si c'est bon.

@+

 

[BOISGONTIER]

Re : Repartir des données ds plusieurs classeurs (bis)

Bonjour,

Sub Extrait()
  Set bd = Sheets("BD")
  bd.Select
  '--- Liste des domaines
  [A1:J10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[M1], Unique:=True
  bd.Select
  For Each c In Range("M2", [M65000].End(xlUp))   ' pour chaque service
     [M2] = c.Value
     On Error Resume Next
     Sheets(c.Value).Select                 ' la feuille existe t-elle?
     If Err <> 0 Then
       Sheets("Modèle").Copy After:=Sheets(Sheets.Count)   ' création
       ActiveSheet.Name = c.Value
     End If
     '-- extraction
     n = Application.CountA(Range("A1:Z1"))
     bd.[A1:J10000].AdvancedFilter Action:=xlFilterCopy, _
       CriteriaRange:=bd.[M1:M2], CopyToRange:=[A1].Resize(1, n)
     Bd.select
   Next c
End Sub

JB
Formation Excel VBA JB

 

[STATURF]

Re : Repartir des données ds plusieurs classeurs (bis)

Merci à tous les deux.
Je suis novice au niveau macro, quelqu'un peut-il m'aider ......