Importer certains données d'un tableau source

Bonjour

(voir les images)

je veux transférer uniquement les données des colonnes en fleches vers les colonnes dédiées de la feuille Crédit en reprenant uniquement ceux en bleu cad type 05 et de l'utilisateur 2566.

et si le lendemain je remplace les données sur la feuille BD…il doit importer le nouveaux données en les mettant après ceux déjà existant…cad il continue la suite de ce tableau

Si déja testé le filtre avancé...mais il efface les anciens données importés et les remplace par les nouveaux...et moi je veux garder aussi les anciens

Merci bcp

Bonjour anasimo

anasimo a écrit :

Si déja testé le filtre avancé...mais il efface les anciens données importés et les remplace par les nouveaux...et moi je veux garder aussi les anciens

C'est ce que j'allais te proposer : tu passes en effet par une première étape de filtre avancé, et ensuite tu recopies les données en bloc dans ton tableau résultat.

Sub IMPORTER()
    Sheets("BD").Range("A1:P" & Sheets("BD").Cells(Rows.Count, 1).End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Extrait").Range("A1:B2"), CopyToRange:=Sheets("Extrait").Range("A4:G4"), Unique:=False
    Sheets("Extrait").Range("A5:G" & Sheets("Extrait").Cells(Rows.Count, 1).End(xlUp).Row).Copy _
        Destination:=Sheets("Crédit").Range("D" & Sheets("Crédit").Cells(Rows.Count, 4).End(xlUp).Row + 1)
End Sub

Bien joué Steelson...merci beaucoup c'est nickel

si par exemple je veux modifier le critère de sélection...cad au lieu cette fois de l'utilisateur 2566 je le remplace par d'autres ou ajouter d'autres matricules

comme le montre l'image suivante .....cad il doit les chercher dans cette feuille nommé "Utilisateurs"

et merci bcp

J'ai fait évoluer la macro comme ceci CriteriaRange:=Sheets("Extrait").Range("A1").CurrentRegion, tu peux ajouter autant de critères que tu veux, jusque ligne 8

Sub IMPORTER()

    Sheets("BD").Range("A1:P" & Sheets("BD").Cells(Rows.Count, 1).End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Extrait").Range("A1").CurrentRegion, _
        CopyToRange:=Sheets("Extrait").Range("A10:G10"), Unique:=False

    Sheets("Extrait").Range("A11:G" & Sheets("Extrait").Cells(Rows.Count, 1).End(xlUp).Row).Copy _
        Destination:=Sheets("Crédit").Range("D" & Sheets("Crédit").Cells(Rows.Count, 4).End(xlUp).Row + 1)

End Sub

merci beaucoup...manque juste un truc pour que le travail soit complet .......je veux qu'une fois les données importées le fichier source doit s'effacer...car à chaque fois je clique sur le bouton il les importe (risque de doublons)

et merci encore une fois

Ajoute Sheets("BD").Range("A1").CurrentRegion.Offset(1, 0).Clear

Sub IMPORTER()

    Sheets("BD").Range("A1:P" & Sheets("BD").Cells(Rows.Count, 1).End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Extrait").Range("A1").CurrentRegion, _
        CopyToRange:=Sheets("Extrait").Range("A10:G10"), Unique:=False

    Sheets("Extrait").Range("A11:G" & Sheets("Extrait").Cells(Rows.Count, 1).End(xlUp).Row).Copy _
        Destination:=Sheets("Crédit").Range("D" & Sheets("Crédit").Cells(Rows.Count, 4).End(xlUp).Row + 1)

    Sheets("BD").Range("A1").CurrentRegion.Offset(1, 0).Clear

End Sub

parfait les données sont importés, puis la base source est effacée ....mais le hic quand je clique sur le bouton importer il me sort ce message (je sais qu'il ne trouve rien à importer)....de préférence d'avoir un message de ce genre (image).....et merci encore une fois

Adapte le message Aucune donnée ! à ce que tu souhaites ...

Sub IMPORTER()

    If Sheets("BD").Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
        MsgBox "Aucune donnée !"
        Exit Sub
    End If

    Sheets("BD").Range("A1:P" & Sheets("BD").Cells(Rows.Count, 1).End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Extrait").Range("A1").CurrentRegion, _
        CopyToRange:=Sheets("Extrait").Range("A10:G10"), Unique:=False

    Sheets("Extrait").Range("A11:G" & Sheets("Extrait").Cells(Rows.Count, 1).End(xlUp).Row).Copy _
        Destination:=Sheets("Crédit").Range("D" & Sheets("Crédit").Cells(Rows.Count, 4).End(xlUp).Row + 1)

    Sheets("BD").Range("A1").CurrentRegion.Offset(1, 0).Clear

End Sub

PARFAIT !!!! très satisfait....et Merci beaucoup ....

donc je peux renommer les colonnes et les noms des feuilles

OUI, à condition de respecter strictement l'orthographe, y compris les espaces (attention aux espaces parasite à la fin des mots)

c'est noté...et Merci beaucoup Steelson pour votre collaboration et amabilité