Macro recherche copie CTRL+ F

Le
yohannlemoine
Bonjour,

Voila j'ai un petit soucis j'ai créer un macro enregistrée de CTRL+F
qui me recherche une valeur dans une collonne et je voudrais qu'a
chaque fois qu'elle me trouve cette valeur elle me copie les 3 cellule
adjacente dans une feuille annexes et ceci jusqu'a la fin de la
collonne.

je passe avec une macro car je n'arrive pas a le faire avec les
fonction INDEX EQUIV, qui me donne toujour la première occurence.

Je vous remerci de votre aide et veuillez trouvez mon code ci-dessous


'Fonction Recherche



Dim clesociété


Sheets("SUIVI COMMERCIAL").Select
clesociété = Range("E4").Value

Sheets("DATA").Select
Columns("S:S").Select
Selection.Find(What:=clesociété, After:=ActiveCell,
LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
'La je voudrais copier les cellules T a V adjacente à la valeur
trouver puis les copier par exemple en A1 d'une feuille n

Selection.FindNext(After:=ActiveCell).Activate ' puis passer à la
valeur suivante
'et copier les cellules T a V adjacente à la valeur trouver puis les
copier par exemple en A2 d'une feuille n
' ainsi de suite jusqu'a la fin de la collonne S


Cordialement Yohann
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Charabeuh
Le #16756611
Bonjour,

Essaye un truc de ce genre. On devrait pas en être loin.

'---------------------------------------------------------------------------------
Public Sub AAA()

Sheets("Cible").Range("A:C").ClearContents
N = -1
clesociété = Sheets("SUIVI COMMERCIAL").Range("E4").Value

With Worksheets("DATA").Range("S:S")
Set c = .Find(clesociété , LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
N = N + 1
For i = 0 To 2
Sheets("Cible").Range("$A$1").Offset(N, i).Value = _
c.Offset(0, i + 1).Value
Next i
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
Loop Until (firstAddress = c.Address)
End If
End With

End Sub
'---------------------------------------------------------------------------------





news:
Bonjour,

Voila j'ai un petit soucis j'ai créer un macro enregistrée de CTRL+F
qui me recherche une valeur dans une collonne et je voudrais qu'a
chaque fois qu'elle me trouve cette valeur elle me copie les 3 cellule
adjacente dans une feuille annexes et ceci jusqu'a la fin de la
collonne.

je passe avec une macro car je n'arrive pas a le faire avec les
fonction INDEX EQUIV, qui me donne toujour la première occurence.

Je vous remerci de votre aide et veuillez trouvez mon code ci-dessous


'Fonction Recherche



Dim clesociété


Sheets("SUIVI COMMERCIAL").Select
clesociété = Range("E4").Value

Sheets("DATA").Select
Columns("S:S").Select
Selection.Find(What:=clesociété, After:¬tiveCell,
LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:úlse).Activate
'La je voudrais copier les cellules T a V adjacente à la valeur
trouver puis les copier par exemple en A1 d'une feuille n

Selection.FindNext(After:¬tiveCell).Activate ' puis passer à la
valeur suivante
'et copier les cellules T a V adjacente à la valeur trouver puis les
copier par exemple en A2 d'une feuille n
' ainsi de suite jusqu'a la fin de la collonne S


Cordialement Yohann
Daniel.C
Le #16756831
Bonsoir.
Essaie comme çela :

Sub Recherche()
Dim clesociété, c As Range, ResAdr As String


Sheets("SUIVI COMMERCIAL").Select
clesociété = Range("E4").Value

Sheets("DATA").Select
Columns("S:S").Select
Set c = Selection.Find(What:=clesociété, After:¬tiveCell, _
LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:= _
False, SearchFormat:úlse)
If Not c Is Nothing Then
ResAdr = c.Address
Do
Range("T" & c.Row & ":V" & c.Row).Copy
'*** ici, tu colles où tu veux
Set c = Selection.FindNext(c)
Loop Until c = "" Or c.Address = ResAdr
End If

End Sub

Cordialement.
Daniel

Bonjour,

Voila j'ai un petit soucis j'ai créer un macro enregistrée de CTRL+F
qui me recherche une valeur dans une collonne et je voudrais qu'a
chaque fois qu'elle me trouve cette valeur elle me copie les 3 cellule
adjacente dans une feuille annexes et ceci jusqu'a la fin de la
collonne.

je passe avec une macro car je n'arrive pas a le faire avec les
fonction INDEX EQUIV, qui me donne toujour la première occurence.

Je vous remerci de votre aide et veuillez trouvez mon code ci-dessous


'Fonction Recherche



Dim clesociété


Sheets("SUIVI COMMERCIAL").Select
clesociété = Range("E4").Value

Sheets("DATA").Select
Columns("S:S").Select
Selection.Find(What:=clesociété, After:¬tiveCell,
LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:úlse).Activate
'La je voudrais copier les cellules T a V adjacente à la valeur
trouver puis les copier par exemple en A1 d'une feuille n

Selection.FindNext(After:¬tiveCell).Activate ' puis passer à la
valeur suivante
'et copier les cellules T a V adjacente à la valeur trouver puis les
copier par exemple en A2 d'une feuille n
' ainsi de suite jusqu'a la fin de la collonne S


Cordialement Yohann
yohannlemoine
Le #16761241
On 8 sep, 19:29, "Daniel.C"
Bonsoir.
Essaie comme çela :

SubRecherche()
Dim clesociété, c As Range, ResAdr As String

    Sheets("SUIVI COMMERCIAL").Select
    clesociété = Range("E4").Value

    Sheets("DATA").Select
    Columns("S:S").Select
    Set c = Selection.Find(What:=clesociété, After:¬tiveC ell, _
LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByColumns, SearchDirection: =xlNext, _
MatchCase:= _
        False, SearchFormat:úlse)
    If Not c Is Nothing Then
        ResAdr = c.Address
        Do
            Range("T" & c.Row & ":V" & c.Row).Copy
            '*** ici, tu colles où tu veux
            Set c = Selection.FindNext(c)
        Loop Until c = "" Or c.Address = ResAdr
    End If

End Sub

Cordialement.
Daniel

Bonjour,

Voila j'ai un petit soucis j'ai créer un macro enregistrée de CTRL+F
qui merechercheune valeur dans une collonne et je voudrais qu'a
chaque fois qu'elle me trouve cette valeur elle me copie les 3 cellule
adjacente dans une feuille annexes et ceci jusqu'a la fin de la
collonne.

je passe avec une macro car je n'arrive pas a le faire avec les
fonction INDEX EQUIV, qui me donne toujour la première occurence.

Je vous remerci de votre aide et veuillez trouvez mon code ci-dessous

'FonctionRecherche

    Dim clesociété

    Sheets("SUIVI COMMERCIAL").Select
    clesociété = Range("E4").Value

    Sheets("DATA").Select
    Columns("S:S").Select
    Selection.Find(What:=clesociété, After:¬tiveCell,
LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByColumns, SearchDirection: =xlNext,
MatchCase:= _
        False, SearchFormat:úlse).Activate
'La je voudrais copier les cellules T a V adjacente à la valeur
trouver puis les copier par exemple en A1 d'une feuille n

    Selection.FindNext(After:¬tiveCell).Activate ' puis passer à la
valeur suivante
'et copier les cellules T a V adjacente à la valeur trouver puis les
copier par exemple en A2 d'une feuille n
' ainsi de suite jusqu'a la fin de la collonne S

Cordialement Yohann



Merci à vous deux pour vos réponses, je vais tester cela de suite.
Bonne journée
Publicité
Poster une réponse
Anonyme