Extraire des données

Bonjour a tous,

je cherche a extraire des données d'une base de donné, voir fichier joint.

Un grand merci pour votre aide

Bonjour,

Pour obtenir des réponses correctes, il faudrait donner un pu plus d'explications:

-Les bandes colorées existe-elles rééllement?

-Si ce n'est pas le cas, Quelles sont les caractères qu'on peut trouver dans la colonne DEPT UNIF: (T,U,V,W ou autres choses)?

Enfin tout ce qui permet de distinguer les lignes.

Cdlt

En attendant votre retour, voici déjà une proposition

Cdlt

Autre version plus rapide

Bonjour,

les couleurs des lignes n'existe pas.

votre macro est intéressante, mais t il possible d'obtenir ce résultat sans bouton et si il y a d'autres lignes, a savoir que les données peuvent se modifier (avoir plus de lignes par dept)?

Merci

j'ai compris et ça marche. Merci.

est il possible que le bouton soit dans un autre onglet? si oui, comment?

Merci

le déplacement du bouton dans un autre onglet ok, mais le bouton ne fait plus fonctionner la macro!

Ah oui excusez-moi, j'avais oublié de corrigé la macro.

Voici la macro corrigée (remplacez "Feuil1" par le nom de votre feuille ou se situe la base de donnée)

Sub Extract()
    Dim L As Long, i As Long, N° As Long
    Dim Dept As String
    Dim f1 As Worksheet
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    DerLig = f1.Cells.SpecialCells(xlCellTypeLastCell).Row
    L = 4
    Dept = f1.Cells(L, "B")
    N° = f1.Cells(L, "C")
    f1.Cells(L, "G") = Dept
    With f1.Range("C3:C" & DerLig)
        Set n = .Find(N° + 1, lookat:=xlWhole)
        If Not n Is Nothing Then
            Do
                If CDbl(f1.Cells(n.Row, "B")) Then
                    If Err.Number = 0 Then
                        f1.Cells(n.Row, "G") = Dept
                        N° = f1.Cells(n.Row, "C")
                    Else
                        Dept = f1.Cells(n.Row, "B")
                        N° = f1.Cells(n.Row, "C")
                        f1.Cells(n.Row, "G") = Dept
                    End If
                    On Error GoTo 0
                End If
                Set n = .Find(N° + 1, lookat:=xlWhole)
                On Error Resume Next
            Loop While Not n Is Nothing
        End If
    End With
    Set f1 = Nothing
End Sub

Cdlt

Bonjour,

J'ai remplacé la macro, mais le bouton ne fait pas fonctionner la macro, voir fichier joint.

Merci,

Bonjour,

Un oubli sur cette ligne

Set f1 = Sheets("Feuil2")

Il faut remplacer Feuil2 par Feuil1

Essayez

Cdlt

autre probleme, si dans la colonne C, les numéros viennent d'une autre colonne cela ne fonctionne que pour le 1er dept

Désolé de n'avoir pas donné cette information

voir fichier joint

Dans ce cas il suffit de remplacer tout ce qui fait référence à la colonne "C" par la colonne "A"

Sub Extract()
    Dim L As Long, i As Long, N° As Long
    Dim Dept As String
    Dim f1 As Worksheet
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    DerLig = f1.Cells.SpecialCells(xlCellTypeLastCell).Row
    L = 4
    Dept = f1.Cells(L, "B")
    N° = f1.Cells(L, "A")
    f1.Cells(L, "G") = Dept
    With f1.Range("A3:A" & DerLig)
        Set n = .Find(N° + 1, lookat:=xlWhole)
        If Not n Is Nothing Then
            Do
                If CDbl(f1.Cells(n.Row, "B")) Then
                    If Err.Number = 0 Then
                        f1.Cells(n.Row, "G") = Dept
                        N° = f1.Cells(n.Row, "A")
                    Else
                        Dept = f1.Cells(n.Row, "B")
                        N° = f1.Cells(n.Row, "A")
                        f1.Cells(n.Row, "G") = Dept
                    End If
                    On Error GoTo 0
                End If
                Set n = .Find(N° + 1, lookat:=xlWhole)
                On Error Resume Next
            Loop While Not n Is Nothing
        End If
    End With
    Set f1 = Nothing
End Sub

désolé de mal m'exprimer. toutes les données des colonnes B, C, etc. viennent d'un autre fichier!

Ce n'est pas que vous vous exprimez mal, mais vous ne dévoilez les informations qu'au compte gouttes.

toutes les données des colonnes B, C, etc. viennent d'un autre fichier! Que dois-je comprendre, qu'il faille les chercher directement dans un autre fichier ou bien c'est vous qui faites un copié-collé de ces informations dans une des feuilles de votre fichier ?

Dans ce cas , voici une autre proposition.

Sur le fichier contenant la macro, on crée une feuille "Emplacement du fichier donnees", dans laquelle on y met l'emplacement du fichier et le nom du fichier à traiter.

Le clic sur le bouton "Résultat" , ouvre le fichier de données trouvé à l'emplacement indiqué, et applique ce que le traitement demandé.

j'ai considéré que les N° étaient en colonne A.

Cdlt

erreur d’exécution 9,

le nom du fichier est STAT2021et j'ai écris dans la macro :

Set f2 = Sheets("\STAT2021.xlsm")

Je crois que vous mélangez tout, "STAT2021.xlsm" est le nom du classeur et "Feuil2" est le nom de la feuille du fichier "STAT2021.xlsm" dans laquelle se trouvent les données.

Donc si tout correspond , le chemin "C:\Users\chris\Desktop\UNIF\UNIFBASE\STAT\STAT 2021", le fichier "STAT2021.xls" et la feuille "Feuil2", cela devrait fonctionner. Est-ce que tout ces paramètres sont corrects? sinon corrigez.

Rappel: le chemin comprend:

-la lettre du lecteur, ici le C,

-les noms des répertoires et sous-répertoires, ici: \Users\chris\Desktop\UNIF\UNIFBASE\STAT\STAT 2021

-le programme va donc chercher le fichier "STAT2021.xls" qui se trouve dans "C:\Users\chris\Desktop\UNIF\UNIFBASE\STAT\STAT 2021".

et va compléter la feuille "Feuil2" de ce fichier.

Au fait, quel est le nom réel du classeur: "STAT2021.xlsm" ou "STAT2021.xls", là aussi mettre les bonnes valeurs.