Discussion :

[themansion]

Bonjour,

Je cherche a trier automatiquement les donnees de sheet1

RESULTAT SOUHAITE:
Dans sheet1:
Si une cellule de la colone f contient le mot "aaa" alors couper la ligne entiere correspondante et deplacer vers la sheet2
Si une cellule de la colone f contient le mot "bbb" alors couper la ligne entiere correspondante et deplacer vers la sheet3
Ainsi de suite.
En resume:
En fonction dun mot clef de la colone f, trier les lignes vers les sheet 2, 3, 4 etc.

En utilisant la macro (copiee depuis un site internet, je naurais pas su rediger ca!) ci dessous le RESULTAT OBTENU est parfait pour traiter le mot clef "aaa" : si le mot clef aaa est contenu dans la colone f alors la ligne correspondante est copie dans sheet 2


Jaurai aime que cette meme macro puisse traiter plusieurs mots clefs, pour deplacer chaque ligne vers la sheet correspondante.

Je ne comprends pas la moitie des codes utilises ci dessous, mais si vous voulez bien maider a modifier la macro, je vous en suis tres reconnaissant!

Bonne journee a tous,

Elie

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
31
32
33
Sub CutData() * 
 
Dim sStr as String, Cell as Range, rng as Range * 
 
sStr = "#aaa#" * 
 
for each cell in Range("F2:F200") * 
 
if Instr(1,sStr,Cell.Value,vbTextCompare)>0 then *
 
if rng is nothing then * 
 
set rng = cell *
 
else * 
 
set rng = union(rng,cell) * 
 
end if * 
 
end if * 
 
Next * 
 
if not rng is nothing then * 
 
rng.EntireRow.copy Destination:=worksheets("sheet2").Range("A1") * 
 
rng.EntireRow.Delete * 
 
End if * 
 
End Sub

[gFZT82]

Bonjour,

Voici une solution utilisant la méthode Find

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
Sub CutData()
Dim MotCle
Dim i As Byte
Dim C As Range
Dim F As String
Dim Ligne As Long
    'On définit les mots clés
    MotCle = Array("aaa", "bbb", "ccc")
    'On effectue la recherche de chaque mot clé dans la colonne F de la sheet1
    For i = 0 To UBound(MotCle)
        Do
            Set C = Worksheets("sheet1").Columns(6).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
            'Si le mot clé est trouvé
            If Not C Is Nothing Then
                'On définit le nom de la feuille où sera effectuée la copie
                F = "sheet" & (i + 2)
                With Worksheets(F)
                    'On définit la ligne où sera effectué le collage
                    Ligne = .Range("F" & Rows.Count).End(xlUp).Row + 1
                    'On effectue le copier / coller
                    C.EntireRow.Copy .Range("A" & Ligne)
                    'On supprime la ligne dans la sheet1
                    C.EntireRow.Delete
                End With
            End If
        Loop While Not C Is Nothing
    Next i
End Sub

Cordialement.

[themansion]

Bonjour,

Ca marche parfaitement!

Cela reduira un travail qui aurait durer des heures a un clic! Excellent!

Milles merci et bonne journee,

Elie

[themansion]

Bonjour,

Le code ci dessous permet de couper puis copier une ligne entiere vers une nouvelle sheet si un mot clef predifini y est present. Cela marche parfaitement.

Je cherche a modifier le code afin que la recherche du mot clef se fasse uniquement dans les lignes 100 a 500

Je pensais quil fallait que je modifie cette ligne:

Code :

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

Set C = Worksheets("sheet1").Columns(6).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)

Code :

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

Set C = Worksheets("sheet1").Columns(6).Rows(100:500).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)

mais non ca ne marche pas... Une idee sil vous plait?

Bonjour,

Voici une solution utilisant la méthode Find

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
Sub CutData()
Dim MotCle
Dim i As Byte
Dim C As Range
Dim F As String
Dim Ligne As Long
    'On définit les mots clés
    MotCle = Array("aaa", "bbb", "ccc")
    'On effectue la recherche de chaque mot clé dans la colonne F de la sheet1
    For i = 0 To UBound(MotCle)
        Do
            Set C = Worksheets("sheet1").Columns(6).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
            'Si le mot clé est trouvé
            If Not C Is Nothing Then
                'On définit le nom de la feuille où sera effectuée la copie
                F = "sheet" & (i + 2)
                With Worksheets(F)
                    'On définit la ligne où sera effectué le collage
                    Ligne = .Range("F" & Rows.Count).End(xlUp).Row + 1
                    'On effectue le copier / coller
                    C.EntireRow.Copy .Range("A" & Ligne)
                    'On supprime la ligne dans la sheet1
                    C.EntireRow.Delete
                End With
            End If
        Loop While Not C Is Nothing
    Next i
End Sub

Cordialement.

[keygen08]

Bonjour

Set C = Worksheets("sheet1").Columns(6).Rows(100:500).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)

A modifié comme suit :

Code :

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

Set C = Worksheets("sheet1").range("f100:f500").Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)