XL 2016 filtrer, copier et coller les données avec la macro

[GUEWOU]

bonjour,
je sollicite votre aide pour compléter le code VBA que j'ai commencé. en fait dans le fichier ci-joint, je souhaite extraire les 3 caractères à partir de la gauche des données de la colonne "B" et reporter le résultat sur la même ligne de la colonne "D". notre code gère seulement la ligne 2 pourtant je veux gérer toutes les lignes.
en suite je veux filtrer dans la colonne "D" toutes les valeurs "321" et "326"
en fin je veux copier à partir de colonne "A" toutes les valeurs filtrées et les coller dans la feuille "Agence 321 et 326 a partir de la cellule "A2".

je compte sur votre bonne compréhension

 

[sylvanu]

Bonjour Guewou,
( Attention PJ modifiée (V2) car macro incomplète dans V1 )
Une possibilité en utilisant une formule dans la bonne plage, ce qui est très rapide, avec :

Sub tri_et_filtre()
' tri_des_données Macro
    Dim f As Worksheet, Plage As Range
    Application.ScreenUpdating = False
    Set f = ThisWorkbook.Sheets("Base")
    Set Plage = f.Range("D2:D" & Cells(Rows.Count, "B").End(xlUp).Row)
    Plage.Formula = "=LEFT(B2,3)"   ' Formule en col D : =GAUCHE(B2;3)
    Plage.Value = Plage.Value       ' Supprime formule, met valeurs.
    Plage.NumberFormat = "000"      ' Met le bon format
    Set Plage = f.Range("A1:D" & Cells(Rows.Count, "B").End(xlUp).Row)
    Plage.AutoFilter                ' Pose filtres en col  A:D
    Plage.AutoFilter Field:=4, Criteria1:="=321", Operator:=xlOr, Criteria2:="=326" ' filtrage sur 321 et 326
    Sheets("Agence 321").Select
    Plage.Copy Destination:=Sheets("Agence 321").[A1]   ' Colle tableau filtré
    Plage.AutoFilter
End Sub

 

[GUEWOU]

merci déjà pour ce bout de code
mais il y'a encore deux tâches:
filtrer les valeurs "321" et "326"
copier les valeurs filtrées et coller dans la feuille "Agence 321"

 

[sylvanu]

Sorry ! Je viens d'updater mon post #2
Effectivement

mais il y'a encore deux tâches:
filtrer les valeurs "321" et "326"
copier les valeurs filtrées et coller dans la feuille "Agence 321"

C'est fait dans la V2.

 

[job75]

Bonjour GUEWOU, sylvanu,

Voici une solution qui utilise le filtre avancé avec cette macro dans le code de la 2ème feuille :

Private Sub Worksheet_Activate()
Dim agence1, agence2, critere As Range
agence1 = 321: agence2 = 326 'modifiables
With Sheets("Base").[A1].CurrentRegion
    Set critere = .Cells(2, .Columns.Count + 2)
    critere = "=OR(LEFT(B2,3)=""" & agence1 & """,LEFT(B2,3)=""" & agence2 & """)"
    .AdvancedFilter xlFilterCopy, critere(0).Resize(2), CopyToRange:=[A1] 'filtre avancé copié
    critere = ""
End With
Me.Name = "Agences " & agence1 & "-" & agence2 'renomme la feuille
End Sub

Elle se déclenche automatiquement quand on active la feuille.

A+