Base de donnée

[godux60]

Bonjour,

je souhaite créer un ficher mais je n'y arrive pas, j'ai essayé un tableau croisé dynamique mais cela ne convient pas.

Je vous expose mon problème, sur ma 1ère feuille j'ai toute ma liste des documents et dans les autres feuilles je voudrais la liste des documents corespondant qu'a un seul critère (processus dans le fichier joint).

Je souhaiterais que les feuilles avec les critères se met à jour automatiquement lorsque je mets à jour la feuille avec tous les documents.

Je vous joins mon fichier pour plus de détail.

Merci d'avance de voler à mon secours.

Cordialement

Cédric

 

[JBOBO]

Re : Base de donnée

BONJOUR,

Un essai avec l'enregistreur de macro :

Sub essai2()
'
' essai2 Macro
'

'
    Sheets("tous les documents").Select
    Cells.Select
    Selection.Copy
    Sheets("qualité").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("fab").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("RH").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("tous les documents").Select
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("A2").Select
    Sheets("qualité").Select
    Range("A3:F3").Select
    Selection.AutoFilter
    Sheets("fab").Select
    Range("A3:F3").Select
    Selection.AutoFilter
    Sheets("RH").Select
    Range("A3:F3").Select
    Selection.AutoFilter
    Sheets("qualité").Select
    Range("A3").Select
    ActiveSheet.Range("$A$3:$F$21").AutoFilter Field:=1, Criteria1:="Qualité"
    Sheets("fab").Select
    Range("A3").Select
    ActiveSheet.Range("$A$3:$F$21").AutoFilter Field:=1, Criteria1:="Fab"
    Sheets("RH").Select
    Range("A3").Select
    ActiveSheet.Range("$A$3:$F$21").AutoFilter Field:=1, Criteria1:="RH"
    Sheets("tous les documents").Select
    Range("A2").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A2").Select
End Sub

 

[mth]

Re : Base de donnée

Bonsoir godux60, JBOBO,

Un autre essai à base de filtre élaboré (les critères des filtres sont en cellules A1:A2 des onglets, voir fichier joint)

Sub MAJ()
Dim Lig As Long
Lig = Sheets("tous les documents").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Qualité")
    .Range(.Range("A4:F4"), .Range("A4:F4").End(xlDown)).ClearContents
    Sheets("tous les documents").Range("A3:F" & Lig).AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=Sheets("qualité").Range("A1:A2"), _
        CopyToRange:=.Range("A4"), Unique:=False
End With
With Sheets("fab")
    .Range(.Range("A4:F4"), .Range("A4:F4").End(xlDown)).ClearContents
    Sheets("tous les documents").Range("A3:F" & Lig).AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=Sheets("fab").Range("A1:A2"), _
        CopyToRange:=.Range("A4"), Unique:=False
End With
With Sheets("RH")
    .Range(.Range("A4:F4"), .Range("A4:F4").End(xlDown)).ClearContents
    Sheets("tous les documents").Range("A3:F" & Lig).AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=Sheets("RH").Range("A1:A2"), _
        CopyToRange:=.Range("A4"), Unique:=False
End With

End Sub

Bonne soirée,

mth

 

[Bebere]

Re : Base de donnée

bonjour Godux,Mth,Jbobo
avec le filtre élaboré
à bientôt