[VBA]Copier données d'un tableau suivant une table

guitou5995

XLDnaute Nouveau
Bonjour,

J'utilise VBA très rarement et mes compétences sont (très) limitées. de plus je ne trouve pas dans le forum de réponse à mon problème. je vous explique mon souci : on m'a assigné un nombre de projets identifiés par un numéro (onglet projet). J'ai besoin de rapatrier toutes les lignes comportant ce numéro et ayant une activité différente depuis le tableau présent dans l'onglet Extract dans un 3ème onglet (Restitution).
je vous joins le fichier afin de mieux comprendre (j'espère)
infos supplémentaires, j'ai une cinquantaine de projets et un tableau de départ à 34000 lignes
Merci pour votre aide
 

Fichiers joints

BOISGONTIER

XLDnaute Barbatruc
Bonjour,

Découpe la BD en onglets (par projet)
Le modèle peut être modifié (ordre des colonnes e.g.)

VB:
Sub Extrait()
  Set f = Sheets("BD")
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  f.[L1] = f.[A1]     ' colonne critère (adapter)
  '--- Liste des projets
  f.[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=f.[L1], Unique:=True
  For Each c In f.Range("L2:L" & f.[L65000].End(xlUp).Row)   ' pour chaque projet
     f.[L2] = c.Value
     On Error Resume Next
     Sheets(CStr(c.Value)).Delete
     On Error GoTo 0
     Sheets("Modèle").Copy After:=Sheets(Sheets.Count)   ' création
     ActiveSheet.Name = CStr(c.Value)
     '-- extraction
     f.[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[L1:L2], CopyToRange:=[A1:J1]
   Next c
   f.Select
End Sub
Boisgontier
 

Fichiers joints

Dernière édition:

guitou5995

XLDnaute Nouveau
Merci beaucoup pour ce retour. Par contre, je n'ai besoin que des codes présents dans l'onglet "Projets" et d'avoir cet extract dans un seul onglet.
 

Discussions similaires


Haut Bas