Help ! modifier la macro suivante...

[philest]

Bonjour à tout le forum,
j'ai besoin d'aide pour la macro çi-dessous.
Celle çi s'apparente aux fonctions "recherche" et "Filtres", et à partir de la cellule active, les valeurs correspondantes trouvées sur la feuille entière, sont selectionnées (lignes entières à partir de la valeur trouvée), puis copiées sur une autre feuille ("trouvé").
Quelqu'un peut il modifier la macro pour assurer la recherche d'une valeur uniquement sur la colonne de la cellule active et non pas sur les autres colonnes ?
Merci pour votre aide.


Sub Conso()
Dim lavaleur As String, Cell As Range, ligne As Integer
'
lavaleur = ActiveCell.Value
' Quitte si la cellule est vide
If ActiveCell.Value = "" Then Exit Sub
For Each Cell In Columns.Range("A1").CurrentRegion
If Cell.Value = lavaleur Then
ligne = Sheets("trouvé").Range("A65536").End(xlUp).Row + 1
Sheets("trouvé").Range("A" & ligne, "AL" & ligne).Value = Cell.EntireRow.Range("A1:AL1").Value
End If
Next Cell
Application.CutCopyMode = False
Sheets("trouvé").Activate
End Sub

 

[Robert]

Re : Help ! modifier la macro suivante...

Bonjour Philest, bonjour le forum,

Je te propose ceci :

Sub Conso()
Dim lavaleur As String, Cell As Range, ligne As Integer
Dim col As Byte
Dim dest As Range
 
' Quitte si la cellule est vide
If ActiveCell.Value = "" Then Exit Sub
 
lavaleur = ActiveCell.Value
col = ActiveCell.Column
 
For Each Cell In Range(Cells(1, col), Cells(65536, col).End(xlUp))
        
    If Cell.Value = lavaleur Then
        Set dest = Sheets("trouvé").Range("A65536").End(xlUp).Offset(1, 0)
        Cell.EntireRow.Copy Destination:=dest
    End If
Next Cell
Sheets("trouvé").Activate
End Sub

 

[philest]

Re : Help ! modifier la macro suivante...

Robert,

c'est aux poils ! tout a fait ce que je voulais.
un grand merci pour ta réactivité et la limpidité du code

philest