Discussion :

[chipster008]

Bonjour,

Je me sers actuellement du code suivant pour faire des recherches sur mon fichier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
26
27
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastLig As Long
 
Application.ScreenUpdating = False
'Si la cellule modifié est B2
If Target.Address = "$B$2" Then
    'Les données seront copiées à partir de la ligne 8 de la feuille Consultation
    Range("A8").CurrentRegion.Clear
    'Si la cellule B2 est non vide
    If Target.Value <> "" Then
        With Sheets("Base BE")
            'On enlève l'éventuel filtre automatique
            .AutoFilterMode = False
            'la ligne de la dernière cellule remplie de la colonne A de feuille Base
            LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
            'On filtre sur la colonne G de la feuille base be, en prenant comme critère la valeur de B2 (Target)
            .Range("G1:G" & LastLig).AutoFilter Field:=1, Criteria1:=Target.Value
            'On copie les lignes issues du filtre auto (sans la ligne des titres)
            If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
                .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Copy Range("A8")
            End If
            'On enlève notre filtre automatique
            .AutoFilterMode = False
        End With
    End If
End If
End Sub

Je voudrais modifier ce code pour pouvoir rechercher la valeur en B2 sur les colonnes allant de G à CP.

Est ce que quelqu'un peut m'aider ? Merci d'avance

[gFZT82]

Bonjour chipster008,

Essaie avec ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
26
27
28
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LastLig As Long
    Dim Cptr As Long
    Application.ScreenUpdating = False
    'Si la cellule modifié est B2
    If Target.Address = "$B$2" Then
        'Les données seront copiées à partir de la ligne 8 de la feuille Consultation
        Range("A8").CurrentRegion.Clear
        'Si la cellule B2 est non vide
        If Range("$B$2") <> "" Then
            With Sheets("Base BE")
                'On enlève l'éventuel filtre automatique
                .AutoFilterMode = False
                'On recherche la dernier ligne de la colonne G
                LastLig = .Cells(.Rows.Count, "G").End(xlUp).Row
                'On recherche si une cellule contient la valeur de B2
                For i = 1 To LastLig
                    Set c = .Range("G" & i, "CP" & i).Find(Range("$B$2"), LookIn:=xlValues)
                    If Not c Is Nothing Then
                        'On copie la ligne
                        Cptr = Cptr + 1
                        .Range("A" & CStr(c.Row)).EntireRow.Copy Range("A" & Cptr + 7)
                    End If
                Next i
            End With
        End If
    End If
End Sub

Cordialement.