Renvoi automatique de plusieurs lignes d'une base de données

Bonjour,

j'ai un petit problème avec ma base de données. En effet, je souhaiterais lorsque j'utilise ma liste déroulante sur la feuille 2 qu'excel me renvoie toutes les lignes de ma base de données qui contiennent le débiteur sélectionné.

Je précise que cette base de données est amenée à augmenter sensiblement et qu'elle n'est donc qu'une ébauche à l'heure actuelle.

J'ai essayé par le biais des filtres. Le problème est que dans le cas ou un grand nombre de ligne est renvoyé, ma cellule total et ma cellule signature seront décalées. Or tout l'intérêt pour moi de faire ce tableau est d'obtenir non seulement l'ensemble des lignes qui ont en commun le même débiteur mais également de faire la somme de celles-ci pour obtenir un total automatique.

Je ne sais pas si j'ai été assez clair. Dans le cas contraire, je suis à votre entière disposition pour vous donner plus d'informations! Merci d'avance pour vos réponses!

Bonjour

une méthode

Cordialement

Bonjour

Voici un coe à mettre dans la feuille 2

Je ne peux le mettre dans ton fichier je suis en 2003, mais cela doit marcher

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$D$3" Then Exit Sub
With Sheets(1)
    Set zone = .Range(.Cells(1, 4), .Cells(.UsedRange.Rows.Count, 4))
    Set debtableau = ActiveSheet.Range("a7")
    n = 0
    For Each i In zone
    If i = Target Then
        .Range(.Cells(i.Row, 1), .Cells(i.Row, 5)).Copy debtableau.Offset(n, 0)
        n = n + 1
    End If
    Next
End With
With ActiveSheet
Set tableau = .Range(.Cells(debtableau.Row + n, 1), .Cells(.UsedRange.Rows.Count + n, .UsedRange.Columns.Count))
tableau.ClearContents
formule = "=somme(" & debtableau.Offset(0, 4).Address & ":" & debtableau.Offset(n, 4).Address & ")"
.Cells(debtableau.Row + n + 2, 5).FormulaLocal = formule
End With

End Sub

Bonjour à tous,

Solution filtre

si vraiment besoin, on peut mettre le total et la signature en dessous.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lg%
    If Not Application.Intersect(Target, Range("d3")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        Application.ScreenUpdating = False

     With Sheets("base de données")
        Lg = .Range("a65536").End(xlUp).Row
        .Range("o2") = "=d2=tableau!d3" 'critère
        .Range("a1:e" & Lg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        .Range("o1:o2"), CopyToRange:=Range("a6:e6"), Unique:=False
     End With
    End If
End Sub

Bonjour Amadéus

Amicalement

Claude

Merci beaucoup pour vos réponses!

Malheuresement je suis plus que débutant dans le domaine des macros, c'est pourquoi je ne peux exploiter les deux dernières réponses.

-- 20 Mai 2011, 16:19 --

Merci amadeus

Cependant, un problème persiste: lorsque je reporte tes formules dans un autre document, la dernière ligne du tableau en feuille 2 renvoie "N/A". Aussi, pourrais-tu m'expliquer la philosophie de ces formules pour que je puisse trouver une solution par moi même?

dsou a écrit :

Bonjour

Voici un coe à mettre dans la feuille 2

Je ne peux le mettre dans ton fichier je suis en 2003, mais cela doit marcher

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$D$3" Then Exit Sub
With Sheets(1)
    Set zone = .Range(.Cells(1, 4), .Cells(.UsedRange.Rows.Count, 4))
    Set debtableau = ActiveSheet.Range("a7")
    n = 0
    For Each i In zone
    If i = Target Then
        .Range(.Cells(i.Row, 1), .Cells(i.Row, 5)).Copy debtableau.Offset(n, 0)
        n = n + 1
    End If
    Next
End With
With ActiveSheet
Set tableau = .Range(.Cells(debtableau.Row + n, 1), .Cells(.UsedRange.Rows.Count + n, .UsedRange.Columns.Count))
tableau.ClearContents
formule = "=somme(" & debtableau.Offset(0, 4).Address & ":" & debtableau.Offset(n, 4).Address & ")"
.Cells(debtableau.Row + n + 2, 5).FormulaLocal = formule
End With

End Sub

Bonjour,

Ta solution est très intéressante mais je n'arrive pas à l'adapter à un autre classeur!

Peux-tu m'indiquer les modifications à faire? Merci