[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
 

Pièces jointes

  • Extract activité_projet.xlsx
    12.3 KB · Affichages: 6

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
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
 

Pièces jointes

  • Extraction.xlsm
    50.1 KB · Affichages: 9
Dernière édition:

Discussions similaires