Macro ctrl+f sur une zone delimitée

Bonjour,

Je souhaite faire une macro qui ferai un ctrl+f mais ceci sur une zone délimité, j'ai tenté un petit bout de code que je vais vous joindre mais il ne fonctionne pas, le début de la recherche se fait bien comme je veux mais je n'arrive pas à lui indiquer une fin donc le ctrl+f va au bout de la feuille

Voila le code utilisé

Sub essai5()

'

' essai5 Macro

'

Dim J As Long

Dim K As Long

toto = InputBox("ou ?", "Canal")

'Range("A3").Select

J = 1

K = 13

Cells.Find(What:=Cells(4, "K").Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _

xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _

, SearchFormat:=False).Activate

Application.CutCopyMode = False

Selection.Copy

Cells(6, K).Select

ActiveSheet.Paste

Cells(3, J).Select

Application.CutCopyMode = False

Do While J < 8

MsgBox toto

Cells.FindNext(After:=ActiveCell).Activate

Selection.Copy

Cells(6, K).Select

ActiveSheet.Paste

Cells(3, J).Select

Application.CutCopyMode = False

J = J + 1

Loop

End Sub

Merci de votre aide

Si tu veux effectuer une recherche sur une zone donnée tu remplaces le "Cells" de

Cells.Find(...

par

range("A1:B10").Find(...

par exemple.

De même pour

Cells.FindNext(...

que tu transformes en

range("A1:B10").FindNext(...

Hum désoler, mais cela ne fonctionne pas, il me met en mode débogage sur les lignes modifiées avec le Range....

Bonjour oob2,

Est-il possible dans ce cas-là que tu joignes un bout de fichier avec suffisamment de données pour essayer de résoudre ton problème ?

Je n'ai pas la possibilité de l'upload mais je peux te l'envoyer par mail avec + d'explication si tu veux

Merci

Tu ne peux pas mettre des données bidon ?

Si voila c'est fait

Alors mon but final c'est de trouvé tous les "to" qui sont dans la ligne 3 (pour cet exemple) et de les copié dans les case à partir de la case M6 sur une ligne, bon je n'ai pas encore mis en place le système d'incrémentation pour la copie mais déja je n'arrive pas à travailler que sur la ligne 3 le find fini par me trouver le dernier "to" celui de la case source à partir de laquelle la recherche est faites... et cette case est obligatoire pour la suite des opérations que je veux faire.

Merci

Re,

Ok, je vois.

Voici une macro tirée de l'aide excel vba (obtenue en appuyant sur F1 lorsque le curseur de la souris est sur le mot "Find") qui peut correspondre à ce que tu souhaites obtenir :

With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Value = 5
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

Si tu n'arrives pas à adapter, reviens.

Merci, arf je suis désolé mais je n'arrive pas à l'adapter à mon exemple ... je suis un peu perdu là...

Re,

Pas de quoi être désolé oob2 !

Voici ta macro modifiée :

Sub essai5()
    With Worksheets(1).Range("A3:G3")
        Set c = .Find(Cells(4, "K").Value, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                Range("M" & 6 + i).Value = c.Value
                i = i + 1
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Sub

Merci beaucoup ça marche bien je vais continuer à avancer sur mon projet.

J'ai juste modifié le code comme ca pour que ca change de colonne pour la copie et non de ligne.

Sub essai6()

Dim I As Long

I = 13

With Worksheets(1).Range("A3:G3")

Set c = .Find(Cells(4, "K").Value, LookIn:=xlValues)

If Not c Is Nothing Then

firstAddress = c.Address

Do

Cells(6, I).Value = c.Value

I = I + 1

Set c = .FindNext(c)

Loop While Not c Is Nothing And c.Address <> firstAddress

End If

End With

End Sub

Merci encore

oob2 a écrit :

J'ai juste modifié le code comme ca pour que ca change de colonne pour la copie et non de ligne.

Si ton problème est résolu :

Bonjour, j'ai continué à travailler ce week end mais je n'avais pas le net.

J'ai un petit soucis car ma macro me renvoi bien les nom comme il le faut mais les croix dans mon tableau ne se placent pas où il le faut. Je te joins le fichier pour que tu comprennes.

Mon but étant que à partir du bouton 10 (les autres sont des tests) on puisse récupérer les données de la feuille 1 de façon filtrer.

S'il y a un soucis avec le fichier, je le referai pour qu'il soit plus clair.

Merci

Bonjour oob2,

Essaie avec ce code :

Sub essai9()
    Application.ScreenUpdating = False
    'Application.CutCopyMode = False
    Cells.ClearContents
    'Range("A1").Select

    canal = InputBox("Quel canal recherchez-vous ?", "Canal")
    Worksheets("Feuil4").Range("K4") = canal

    Dim I As Long
    Dim J As Long
    I = 13
    J = 2
    With Sheets("Feuil1").Range("A5:I5")
        Set c = .Find(Cells(4, "K").Value, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                Cells(6, I).Value = c.Value
                Sheets("Feuil1").Select
                Range(Cells(6, c.Column), Cells(38, c.Column)).Copy Destination:=Sheets("Feuil4").Cells(7, I)
                ' ActiveCell.EntireColumn.Select
                I = I + 1
                J = J + 1
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
    With Sheets("Feuil4")

        .Range("K5").Value = "x"
        .Range("K6").Value = "x"
        .Range("J6").Value = "x"

        Sheets("Feuil1").Select
        Range("J6:K20").Copy Destination:=.Range("J7")

        'Range("A5").Select

        .Range("J6:CY188").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
                                          .Range("K5:K6"), Unique:=False

        Sheets("Feuil1").Select
        Range("A6:A20").Copy Destination:=.Range("L7")
        .Select
        Range("A1").Select
    End With
End Sub

Merci, cela fonctionne presque, à l'exeption du fait qu'il ne retourne que le nom de la première colonne, en l'occurence "toto" si ton tappe to, dans les colones suivantes les croix sont bien placés mais les noms comme "totote" n'apparaissent pas en tête de colonnes...

Utilise cette macro alors :

Sub essai9()
Dim I As Long
    'Dim J As Long
    'Application.CutCopyMode = False
    Cells.ClearContents
    'Range("A1").Select

    canal = InputBox("Quel canal recherchez-vous ?", "Canal")
    Worksheets("Feuil4").Range("K4") = canal
    Application.ScreenUpdating = False

    I = 13
    'J = 2
    With Sheets("Feuil1").Range("A5:I5")
        Set c = .Find(Cells(4, "K").Value, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                Sheets("Feuil1").Select
                Range(Cells(5, c.Column), Cells(38, c.Column)).Copy Destination:=Sheets("Feuil4").Cells(6, I)
                ' ActiveCell.EntireColumn.Select
                I = I + 1
                'J = J + 1
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
    With Sheets("Feuil4")

        .Range("K5").Value = "x"
        .Range("K6").Value = "x"
        .Range("J6").Value = "x"

        Sheets("Feuil1").Select
        Range("J6:K20").Copy Destination:=.Range("J7")

        'Range("A5").Select

        .Range("J6:CY188").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
                                          .Range("K5:K6"), Unique:=False

        Sheets("Feuil1").Select
        Range("A6:A20").Copy Destination:=.Range("L7")
        .Select
        Range("A1").Select
    End With
End Sub

ok merci beaucoup. Mon problème est résolu, je le marque en résolu. Si j'ai d'autres soucis je ferai un nouveau poste

Bonne journée