Extraction base de données sur plusieurs feuille

Bonsoir,

J 'ai créer un fichier avec une macro le titre se copie mais pas l 'extraction des données selon une liste pouvez vous me la corriger et me mettre en évidence mon anomalie,

Mon souhait serez d'extraire par code de la colonne M

Et de recopiez sur une nouvelle feuille et si possible de la nommer et cela à chaque code

Et cela avec un bouton

Merci d'avance

Cordialement

Bonjour Rbmicho, bonjour le forum,

Le code ci-dessous génère un onglet par Référence :

Sub Macro1()
Dim OB As Worksheet 'déclare la variable OB (Onglet Base)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)

Application.Calculation = xlCalculationManual 'mode de calcul manuel
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OB = Worksheets("BASE AT") 'définit l'onglet OB
TV = OB.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
    If TV(I, 13) <> "" Then D(TV(I, 13)) = "" 'alimente le dictionnaire avec les données en colonne 13 (=> colonne M, les références) si non vides
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionaire D sans doublon
For I = 0 To UBound(TMP) 'boucle sur toutes les références J du tableau temporaire TMP
    On Error Resume Next 'gestion des erreurs (en cas dérreur passe à la ligne suivante)
    Set OD = Worksheets(CStr(TMP(I))) 'définit l'onglet destination OD (génère une erreur si cet onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        Worksheets.Add before:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
        Set OD = ActiveSheet 'définit l'onglet OD
        OD.Name = CStr(TMP(I)) 'renome l'onglet
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    OD.Cells.Clear 'efface le contenu de l'onglet OD
    OB.ListObjects("BASEAT").Range.AutoFilter Field:=13, Criteria1:=TMP(I) 'filtre la base selon le ctitère TMP(J)
    OB.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy OD.Range("A1") 'copie la base filtrée et la colle dans A1 de l'onglet OD
    OB.ListObjects("BASEAT").Range.AutoFilter 'supprime le filtre de la base
Next I 'prochain critère de la boucle
Application.Calculation = xlCalculationAutomatic 'mode de calcul automatique
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Traitement terminé !" 'message
End Sub

Bonjour,

Je débute en macro, cette macro fonctionne t elle avec mon fichier et que faire pour quelle fonctionne à part la copier.

Car je viens de la copier et cela tourne en boucle sur

If TV(I, 13) <> "" Then D(TV(I, 13)) = "" 'alimente le dictionnaire avec les données en colonne 13 (=> colonne M, les références) si non vides

Next I 'prochaine ligne de la boucle

Merci

Cordialement

Re,

Oui elle fonctionne sur ton fichier (en pièce jointe) et oui elle tourne en boucle sur toutes les lignes de la base de donnée. Si tu fais tourner pas à pas c'est interminable mais si tu lances la macro, en quelques secondes les onglets sont créés. En revanche, moi c'est ton fichier que je trouve extrêmement lent. Pourquoi ton tableau structuré BASEAT va jusqu'à la ligne 671 alors qu'il ny 'a que 304 lignes de données ?

Bonjour,

Merci de ta réponse, pour l'instant il n'y a pas beaucoup de ligne mais en fin d'année il peut aller très loin,

Tu as fait quelque chose en dehors de copier la VBA, afin que je puisse le faire sur le fichier original.

D'après toi comme il y a plusieurs personnes dans différents service qui auront besoin de travailler dessus le mieux est de partager le fichier ou de créer plusieurs fichiers et de réalimenter la base après que chacun est complété sa ou ses colonnes.

Merci encore

Cordialement

Re,

Non je n'ai fait que copier le code... Quant à ta seconde question, un fichier partagé me paraît plus simple...

Bonjour,

Puis je profiter encore pour te demander s'il est possible de récupérer les différentes feuilles créer pour mettre à jour la base at.

Je m'explique après extraction chaque service si nécessaire doit modifier la dernière colonne date. Et j'aimerai que la base de données se mette à jour.

Soit avec une macro, ou peut être une formule recherche quand penses tu?

Merci

Re,

Il me paraît plus logique que les modifications soient faites sur la base avant extraction plutôt que de jouer au ping-pong avec les onglets...

Je suis d'accord avec toi, mais certaines infos arrivent dans un logiciel d'un service et pas dans autres

Bonjour,

J'ai oublié de te remercier

Cordialement