[XL-2003] Macro recherche valeur et copier coller [Résolu]

[pm18340]

Bonjour,
Je recherche un code VBA qui me permette de faire l'action suivante :
J'ai un classeur avec trois feuilles (formulaire, base de données et table provisoire)
Je voudrais que, lorsque dans "formulaire", je rentre une donnée en cellule B3, je puisse, par macro, rechercher les lignes de ma base de données qui contiennent cette valeur dans la colonne B et copie chaque ligne dans la table provisoire à partir de ligne 3 (la ligne 1 étant l'entête des colonnes et la ligne 2 doit toujours rester vide).
Cela fait une semaine que je cherche sur internet mais ne trouve rien. Merci de votre aide.

[mercatog]

Bonsoir

Cela fait une semaine que je cherche sur internet mais ne trouve rien.

Il fallait chercher dans ton fichier Excel en utilisant l'enregistreur de macro (pour commencer)

Sinon, une solution clef en main (je ne pense pas qu'elle va t'aider) en utilisant l'évènement Change de ta feuille formulaire combiné avec un filtre automatique sur la colonne B de ta feuille base de données et copie du résultat vers la feuille table provisoire

Code commenté à mettre dans le module de ta feuille formulaire

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastLig As Long
 
Application.ScreenUpdating = False
'Si la cellule changée est B3
If Target.Address(0, 0) = "B3" Then
    'On efface les données de table provisoire
    Worksheets("table provisoire").Range("B3").CurrentRegion.Clear
    'Si la cellule B3 n'est pas vide
    If Target.Value <> "" Then
        With Worksheets("base de données")
            'On supprime l'éventuel filtre automatique
            .AutoFilterMode = False
            'dernière ligne remplie de la colonne B de la feuille base de données
            LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row
            'On filtre la colonne B avec comme critère la valeur entrée en B3 de forumlaire
            .Range("B1:B" & LastLig).AutoFilter field:=1, Criteria1:=Target.Value    'Ou "*" & target.value &"*" 'Si on filtre sur ls données contenant la valeur entrée en B3
            'Si on a ua moins une ligne résultante du filtre, en copie les lignes visibles (sans les titres) en A3
            If .Range("B1:B" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("B2:B" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Copy Worksheets("table provisoire").Range("A3")
            'On supprime notre filtre
            .AutoFilterMode = False
        End With
    End If
End If
End Sub

[pm18340]

Merci à toi. Ca marche avec quelques petites modif mais c'est exactement ce que je recherchais.