Extraire donnée avec critere dans 2 colonnes

Bonjour

j'aimerai extraire les données de la feuil DONNEE vers la page correspondante de la plateforme afin de suivre mon stock en "direct"

le probleme je n'arrive pas a mettre les departs et les arrivees en meme temps avec cette formule

(c'est plus clair dans le fichier)

Sheets("P1").Select

Application.CutCopyMode = False

Sheets("DONNEE").Range("A1:D301").AdvancedFilter Action:= _

xlFilterCopy, CriteriaRange:=Sheets("P1").Range("A1:A2"), _

CopyToRange:=Sheets("P1").Range("A4:D4"), UNIQUE:=False

Sheets("P1").Select

Application.CutCopyMode = False

Sheets("DONNEE").Range("A1:D301").AdvancedFilter Action:= _

xlFilterCopy, CriteriaRange:=Sheets("P1").Range("B1:B2"), _

CopyToRange:=Sheets("P1").Range("A4:D4"), UNIQUE:=False

les departs s'efface pour ne mettre que les arrivees

Merci pour votre aide

Bonjour,

Avec ton fichier exemple, voici quelque chose qui fonctionne...

Mais qu'il faudra peut-être adapter à ton fichier réel???

Sub dispatch()
Dim ShDonn As Worksheet
Dim Platf As Object
Dim DerLig As Long
Dim Plg As Range, Cel As Range
Dim It
Set ShDonn = Worksheets("DONNEE") 'Onglet contenant la BdD
Set Platf = CreateObject("Scripting.Dictionary") 'on crée un Dictionary, permettant d'avoir la liste
                                                'des plateformes sans doublons
DerLig = ShDonn.Cells(Rows.Count, "A").End(xlUp).Row 'calcul de la dernière ligne de la base
Set Plg = ShDonn.Range("A1:D" & DerLig) 'définition de la BdD
For Each Cel In Union(Plg(2).Offset(1).Resize(DerLig - 1), Plg(4).Offset(1).Resize(DerLig - 1))
        'on balaie toutes les cellules des colonnes B et D, sauf les titres
    Platf(Cel.Value) = Cel.Value 'on enregistre le nom des plateformes
Next Cel
For Each It In Platf.Items 'on commence la distribution, avec les items du Dictionary (IT)
    ShDonn.Range("F2").FormulaR1C1 = "=OR(RC2=""" & It & """,RC4=""" & It & """)"
        'on met une formule dans la cellule F2 pour savoir si une des colonnes comporte la plateforme
    Plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ShDonn.Range("F1:F2"), _
        CopyToRange:=Sheets(It).Range("A4:D4"), UNIQUE:=False
        'on effectuer le filtre élaboré vers l'onglet concerné (IT)
Next It
ShDonn.Range("F1:F2").ClearContents 'nettoyage de la formule
End Sub

Bon courage

Bonjour Damien et

Bonjour cousinhub

une variante

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name <> "DONNEE" And Left(Sh.Name, 5) <> "Feuil" Then
        Sheets("DONNEE").Cells(Rows.Count, 1).End(xlUp).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sh.Range("A1").CurrentRegion, CopyToRange:=Sh.Range("A5:D5"), Unique:=False
    End If
End Sub

les critères sont aussi fonction du nom d'onglet

merci Cousin hub

avec les explications c'est assez compréhensible

mais je n'arrive pas a l'adapter a mon vrai classeur.

en vrai la colonne D et en H

du coup de change les différentes lignes concernées:

For Each Cel In Union(Plg(2).Offset(1).Resize(DerLig - 1), Plg(8).Offset(1).Resize(DerLig - 1))

et

ShDonn.Range("K2").FormulaR1C1 = "=OR(RC2=""" & It & """,RC8=""" & It & """)"

'on met une formule dans la cellule k2 pour savoir si une des colonnes comporte la plateforme

Plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ShDonn.Range("K1:K2"), _

CopyToRange:=Sheets(It).Range("A15:I15"), UNIQUE:=False

'on effectuer le filtre élaboré vers l'onglet concerné (IT)

Next It

ShDonn.Range("k1:k2").ClearContents 'nettoyage de la formule

et ça bloque en surlignant cette ligne

For Each Cel In Union(Plg(2).Offset(1).Resize(DerLig - 1), Plg(8).Offset(1).Resize(DerLig - 1))

merci

merci Steelson

Pour l'adapter a mon vrai classeur je colle ou la variante ? en VBA?

Re-,

Si colonne D, il faut mettre Plg(4), et non Plg(2)

Et as-tu redéfini Plg?

Set Plg = ShDonn.Range("A1:D" & DerLig) 'définition de la BdD

Dans mon exemple, il n'y a que 4 colonnes, si tu mets Plg(8), ça coince, effectivement...

Peut-être?

DAMIEN51 a écrit :

merci Steelson

Pour l'adapter a mon vrai classeur je colle ou la variante ? en VBA?

Attention, les critères sont sur 2 lignes et non plus une seule.

Cousinhub,

oui j'ai bien tout changé mais ca ne marche pas,

du coup je suis reparti sur un classeur vierge, j'ai remis ma mise en page souhaitée avec ta macro et ca marche !

merci !

Steelson,

ta formule ne prend que les departs pas les arrivees

Merci pour le temps passé !

bon confinement !!

DAMIEN51 a écrit :

Steelson,

ta formule ne prend que les departs pas les arrivees

bon confinement !!

En fait, en B2 de chaque onglet de ton fichier il manquait un E à N° plateforme ARRIVEE et je ne l'avais pas vu !

Maintenant cela fonctionne