Discussion :

[iboulaye1980]

bonjour à tous !
je souhaite écrire une macro qui cherche un mot sur une colonne de la feuille1 et si elle l'a trouve elle bascule toute la ligne correspondante vers la feuille2 en la supprimant de la feuille1 auriez vous une idée de comment faire !
je vous remercie et vous serez trés reconnaissant pour celle ou celui qui pourrait m'aidez
merci.

[SilkyRoad]

bonjour

Tu peux tester

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
Dim MotCible As String
Dim x As Integer, y As Integer
 
'Le mot à rechercher
MotCible = "DVP"
 
On Error Resume Next
'Recherche d'un mot dans la plage A1:A20 de la Feuil1
x = Application.Match(MotCible, Worksheets("Feuil1").Range("A1:A20"), 0)
On Error GoTo 0
 
If x <> 0 Then
    'Recherche la premiere ligne vide dans la Feuil2
    y = Worksheets("Feuil2").Range("A65536").End(xlUp).Row + 1
 
    Worksheets("Feuil1").Rows(x).Copy _
        Destination:=Worksheets("Feuil2").Cells(y, 1)
    x = 0
End If

michel

[Anthony17]

bonjour,

je fait mes premiers pas sur excel...
je cherche à faire la mème chose que iboulaye1980 mais avec un peu plus de contraintes...
le code ci dessus fonctionne parfaitement (merci à SilkyRoad) mais si il y a deux entrée identique sur la colonne A, la fonction déplace seulement la première ligne. Comment peu t'on s'affranchir de ce problème?

merci d'avance

[hicham28]

bonsoir, je suis interessé aussi pour ce genre de transfert on fais comment pour transferer tout les linges qui reponds au critere rechercher.
merci

[tonton fred]

Bonjour,
Juste une idee en passant, mais pour copier plusieurs lignes qui correspondent au critere il suffirait peut etre de relancer la macro jusqu'a ce qu'elle ne trouve plus rien. Par exemple:

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
29
30
Dim LignePrecedente as Long 'dans la partie declaration du module
 
Sub MacroPrincipale
Dim CopieOk as Boolean
Do
CopieOk = RechercheMot(MotCible)
If  CopieOk = False Then Exit Do
Loop
End Sub
 
Function RechercheMot(MotCible As String) As Boolean
Dim x As Integer, y As Integer
 
On Error Resume Next
'Recherche d'un mot dans la plage A1:A20 de la Feuil1
x = Application.Match(MotCible, Worksheets("Feuil1").Range("A" & LignePrecedente +1 & ":A20"), 0)
On Error GoTo 0
 
If x <> 0 Then
    'Recherche la premiere ligne vide dans la Feuil2
    y = Worksheets("Feuil2").Range("A65536").End(xlUp).Row + 1
 
    Worksheets("Feuil1").Rows(x).Copy _
        Destination:=Worksheets("Feuil2").Cells(y, 1)
    x = 0
   RechercheMot = True
   LignePrecedente = y
Else: RechercheMot = False
End If
End Function

Il faut reinitialiser LignePrecedente entre deux MotCible differents.
Il est aussi possible d'integrer la boucle dans la fonction, enfin voila quoi a adapter...