Discussion :

[yoyo77yo]

Bonjour,

Je vient chercher de l'aide car je souhaite faire un find next et une boucle mais cela ne fonctionne pas : pouvez vous me dire ce qui va pas dans mon code s'il vous plait ?

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
34
35
36
37
38
39
40
41
42
43
 
 
Private Sub CommandButton3_Click()
 
Dim wb As Workbook
Dim ws As Worksheet
 
Dim r As Range 'déclare la variable r (Recherche)
Dim tr As String 'déclare la variable tr (Texte Recherché)
Dim li As Integer 'déclare la variable li (Ligne)
Dim listebox, premiereoccurence As Integer
Dim applitrouvee As Range
Dim tableau(50) As Integer
 
Set wb = Workbooks.Open("U:\ICDC\DPI\OPE\Oac\2.Applicatif\Référentiel applis.xls")
Set ws = wb.Worksheets(1)
 
Sheets("Réf applis").Select
Range("A1").Select
 
tr = TextBox1.Value 'définit la variable tr
 
Set applitrouvee = Cells.Find(What:=tr, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
 
premiereoccurence = applitrouvee.Row
 
If applitrouvee Is Nothing Then
MsgBox "Aucune application trouvée!", , "Résultat"
Else
Do
applitrouvee = Cells.FindNext(applitrouvee)
 
Loop While applitrouvee.Row <> premiereoccurence
 
li = ActiveCell.Row
 
Range("A" & li).Select
 
For listebox = 1 To 4
UserForm2.ListBox1.AddItem Range("A" & li)
Next listebox

[el_slapper]

Je ne vois pas de end if derrièrre le If applitrouvee Is Nothing Then.

soit tu ne l'as pas recopié - et nous aurons du mal à saisir ton code, soit il n'est pas dans ton code - et ça ne risque pas de marcher.

[yoyo77yo]

C'est parceque je n'est pas tout mi : voici mon code entier :

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 
Private Sub CommandButton3_Click()
 
Dim wb As Workbook
Dim ws As Worksheet
 
Dim r As Range 'déclare la variable r (Recherche)
Dim tr As String 'déclare la variable tr (Texte Recherché)
Dim li As Integer 'déclare la variable li (Ligne)
Dim listebox, premiereoccurence As Integer
Dim applitrouvee As Range
Dim tableau(50) As Integer
 
Set wb = Workbooks.Open("U:\ICDC\DPI\OPE\Oac\2.Applicatif\Référentiel applis.xls")
Set ws = wb.Worksheets(1)
 
Sheets("Réf applis").Select
Range("A1").Select
 
tr = TextBox1.Value 'définit la variable tr
 
Set applitrouvee = Cells.Find(What:=tr, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False)
 
premiereoccurence = applitrouvee.Row
 
If applitrouvee Is Nothing Then
    MsgBox "Aucune application trouvée!", , "Résultat"
Else
    Do
        applitrouvee = Cells.FindNext(applitrouvee)
 
    Loop While applitrouvee.Row <> premiereoccurence
 
    li = ActiveCell.Row
 
    Range("A" & li).Select
 
   For listebox = 1 To 4
   UserForm2.ListBox1.AddItem Range("C" & li)
   Next listebox
 
   UserForm2.Show
 
End If
End Sub

peucx tu m'aider ?

[fring]

Bonjour,

En tapant FindNext dans l'aide VBA ou en sélectionnant FindNext dans ton code puis , tu auras un exemple sur son utilisation.

[patricktoulon]

bonjour j'avoue que j'ai du mal a comprendre ce que tu veux faire exactement

avec ta listbox

car apres avoir recherché "applicationtrouvé tout dabors tu n'en fait rien par la suite
et ensuite tu declare "li=active cell.value

et tu boucle 4 fois pour y incrire "li"

j'avoue que je patoge

dis nous exactement ce que tu veux faire avec ton find parceque la en l'etat tu dois pas en faire grand chose

ensuite je te suggere d'eviter de donner des nom ates variables surtout quand l'application les utilise ou tout du moins des mot comme listebox qui est tres proche de listbox qui lui est le nom commun pour le control du memenom

enfin j'arrete de blablater donne un plus d'explications sur ton but et on pourra faire quelque chose



au plaisir

[yoyo77yo]

merci de l'intérêt que vous portez à mon sujet !
Alors en faite le but et de faire un FIND puis un FINDNEXT avec une boucle de facon a trouvé toutes les occurrences recherché a partir d'un tableau

J'aimerai donc qu'il remonte les occurrences trouvée dans ma listbox

Exemple dans un tableau il y a " carotte, navé, cerise, patate douce, patate dur etc...

Si je veut faire une recherche du mot "patate" => alors je souhaite qu'il remonte "patate douce et patate dur" dans ma listebox

Par avance merci

[mercatog]

Bonjour
As tu lu la réponse de Fring (l'aide VBA)

Cet exemple montre comment rechercher toutes les cellules de la plage A1:A500 dans la première feuille de calcul contenant la valeur 2 et comment la remplacer par la valeur 5.

Visual Basic pour Applications

Code :

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

1
2
3
4
5
6
7
8
9
10
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

C'est ce que tu demande, il suffit de lire l'exemple et d'adapter à ton cas.

[yoyo77yo]

le find et find next, je n''ai pas de PB pour le faire : je me suis d'ailleurs inspiré de ce code que l'on trouve dans l'aide VBA ! merci

Ce que je n'arrive pas c'est a remonter les infos trouvé par le find et le findnext dans la listebox

[mercatog]

Ah OK!
Regarde ceci

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
Dim c As Range
Dim TR As String, FirstAddress As String, Tbl() As String
Dim k As Integer
 
TR = Me.TextBox1.Text
If TR <> "" Then
    With Worksheets("Réf applis").Range("a1:a500")
        Set c = .Find(TR, LookIn:=xlValues, lookat:=xlPart)
        If Not c Is Nothing Then
            FirstAddress = c.Address
            Do
                Set c = .FindNext(c)
                k = k + 1
                ReDim Preserve Tbl(1 To k)
                Tbl(k) = c.Value
            Loop While Not c Is Nothing And c.Address <> FirstAddress
            With Me.ListBox1
                .Clear
                .List = Tbl
            End With
        End If
    End With
End If

Après tests, j'ai ré édité la proposition

[yoyo77yo]

TROP fort : t vraiment sympa : merci beaucoup : ca marche du tonner

[patricktoulon]

bonjour
et directement sans tableau et sans redim preserve

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
 
Dim c As Range
Dim  FirstAddress As String
dim TR as string
TR = Me.TextBox1.Text
If TR <> "" Then
With Worksheets("Réf applis").Range("a1:a500")
 Set c = .Find(TR, LookIn:=xlValues, lookat:=xlPart)
 If Not c Is Nothing Then
 FirstAddress = c.Address
 Me.ListBox1.add c.value 
End If       
Do
 Set c = .FindNext(c)
 Me.ListBox1.add c.value 
 Loop While Not c Is Nothing And c.Address <> FirstAddress
    End With

au plaisir

[TChimie]

Bonjour à tous,

Mes tous premiers pas en VBA!! Et j'avoue que c'est presque physiquement douloureux!

Donc voici mon problème: Dans mon classeur il y a 4 feuilles "Results KFT" "Blanks" "Controls" & "Samples"
Dans la première feuille("Results KFT") se trouvent tous les résultats de mes analyses que ce soient des blancs, des contrôles ou des échantillons.
Je veux faire une macro qui me permette de trier mes résultats et de les ranger dans les feuilles suivantes! Pour cela je veux chercher dans la 2eme colonne de ma 1ère page les mots clés suivant "Blanc", "Contrôle" et "échantillon" puis que la ligne où ils apparaissent soient copiée dans la feuille "Blanks" si c'est le mot clé Blanc; "Controls" si c'est Contrôle et évidemment "Samples" si c'est échantillon.
J'ai donc piqué (!) un code Find sur le forum pour y arriver, bon déjà le résultat n'était pas parfait mais surtout ça s'arrête sur le premier "Blanc". Donc j'ai trouvé FindNext (on avance!!) mais c'est plus compliqué, surtout qu'en plus maintenant j'ai un message 'Erreur d'exécution '438': Propriété ou méthode non gérée par cet objet" Ca devient vraiment difficile!!!
Voici mon code, bourré de manque et de bout de truc ajouté pour essayer! Je sais :-(
Est ce que quelqu'un peut m'aider ?
PS: la honte, je ne sais même pas comment faire apparaitre mon code correctement... Soyez indulgent svp!

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
Sub tri_blank_control_sample()
Dim MotCle
Dim NomFeuille
Dim i As Byte
Dim C As Range
Dim B As String
Dim Ligne As Integer
    'On définit les mots clés
    MotCle = Array("Blanc", "Contrôle", "échantillon")
    NomFeuille = Array("Blanks", "Controls", "Samples")
    'On effectue la recherche de chaque mot clé dans la colonne B de la sheet1
    For i = 0 To UBound(MotCle)
        Do
            Set C = Worksheets("KFT results").Columns(2).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
            'Si le mot clé est trouvé
            If Not C Is Nothing Then
            firstAddress = C.Address
                'On définit le nom de la feuille où sera effectuée la copie
                B = NomFeuille(i)
                With Worksheets(B)
                    'On définit la ligne où sera effectué le collage
                    Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    'On effectue le copier / coller
                    C.EntireRow.Copy .Range("A" & Ligne)
 
                Set C = .FindNext(C)
                End With
            End If
        Loop While Not C Is Nothing And C.Address <> firstAddress
Next i
End Sub

[riaolle]

Bonjour et bienvenue dans le forum !

Avant de répondre à ta question :

• Evite d'écrire ta question dans tes discussions "préhistoriques". Il vaut mieux que tu commences une nouvelle discussion quitte à y mettre le lien vers la discussion de laquelle tu t'es inspirée pour ton code.
• Pour "faire apparaitre [ton] code correctement", il faut que tu le mettes entre balises code (pour cela utilise le bouton # dans la barre de menu de la rédaction du message)

Pour la prochaine fois

Ensuite avant de regarder ton code :

Quand je lis "une macro qui me permette de trier mes résultats et de les ranger dans les feuilles suivantes" puis que tu utilises Find avec une boucle, je me dis "aïe"

Pourquoi ?
Avant de penser macro, pensons Excel "à la main". Que ferais-tu pour copier-coller tes données à la main ? Est-ce qu'en colonne B tu cherches la première occurrence de "Blanc", tu copies-colles, puis tu cherches la deuxième occurence, tu copies-colles etc. Oui ? Aïe
Non, il vaut mieux utiliser les filtres !
Alors comment on fait ?

1. On filtre sur "Blanc" en colonne B
2. On copie l'ensemble de la plage obtenue
3. On colle là où on veut.

Si tu n'as pas l'habitude de faire ça à la main, essaie déjà de le faire à la main, puis on va passer en VBA.

Maintenant, comment on fait en VBA ?
On ne se lance pas tout de suite dans le code !
On utilise l'enregistreur de macro et on adapte ce qui en sort.
Déjà essaie cela, puis on continuera

[riaolle]

Je vais compléter ma réponse, en t'expliquant ce qui ne va pas (d'autre ) dans ton code et, entre autre, pourquoi tu as le message d'erreur que tu cites. C'est pour t'aider à progresser et comprendre. Mais je pense que la solution que je te propose dans le message précédent est plus efficace que ce que tu veux faire.

D'abord, conseil : indente ton code, c'est plus facile de s'y retrouver dans les boucles, conditions if, while etc. Voici ton code tel quel :

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
Sub tri_blank_control_sample()
    Dim MotCle
    Dim NomFeuille
    Dim i As Byte
    Dim C As Range
    Dim B As String
    Dim Ligne As Integer
 
    'On définit les mots clés
    MotCle = Array("Blanc", "Contrôle", "échantillon")
    NomFeuille = Array("Blanks", "Controls", "Samples")
    'On effectue la recherche de chaque mot clé dans la colonne B de la sheet1
    For i = 0 To UBound(MotCle)
        Do
            Set C = Worksheets("KFT results").Columns(2).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
            'Si le mot clé est trouvé
            If Not C Is Nothing Then
                firstAddress = C.Address
                'On définit le nom de la feuille où sera effectuée la copie
                B = NomFeuille(i)
                With Worksheets(B)
                    'On définit la ligne où sera effectué le collage
                    Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    'On effectue le copier / coller
                    C.EntireRow.Copy .Range("A" & Ligne)
                    Set C = .FindNext(C)
                End With
            End If
        Loop While Not C Is Nothing And C.Address <> firstAddress
    Next i
End Sub

1. Utilisation de With et FindNext

Faisons un zoom sur le bloc With...End With :

Code :

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

1
2
3
4
5
6
7
With Worksheets(B)
                    'On définit la ligne où sera effectué le collage
                    Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    'On effectue le copier / coller
                    C.EntireRow.Copy .Range("A" & Ligne)
                    Set C = .FindNext(C)
End With

D'après la syntaxe du bloc With...End With, ce qui est écrit en orange ci-dessus est équivalent à :

Code :

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

Set C = Worksheets(B).FindNext(C)

Or comme pour Find que tu as bien écrit, FindNext s'applique sur un Range et pas sur une feuille.
Et en plus, tu es censée faire ta recherche sur la feuille "KFT résultat" et pas sur la feuille B (c'est ce que tu fais dans ton Find). Donc tu ne cherches pas au bon endroit.

Donc première correction :

Code :

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

1
2
3
4
5
6
7
With Worksheets(B)
                    'On définit la ligne où sera effectué le collage
                    Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    'On effectue le copier / coller
                    C.EntireRow.Copy .Range("A" & Ligne)
End With
Set C = Worksheets("KFT results").Columns(2).FindNext(C)

Il n'y aura plus d'erreur, mais tu n'auras quand même pas ce que tu veux ...

2. Find dans la boucle

Pour bien comprendre ce que fait le code à ce stade, exécutons le "virtuellement" pas à pas. On va se concentrer sur la boucle Do... While :

Code :

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

1
2
3
4
5
6
7
8
Do
            Set C = Worksheets("KFT results").Columns(2).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
            'Si le mot clé est trouvé
            If Not C Is Nothing Then
                'blablablablablablablablalbblbla
                Set C = Worksheets("KFT results").Columns(2).FindNext(C)
            End If
Loop While Not C Is Nothing And C.Address <> firstAddress

1. 1ère itération : on cherche le mot clé dans la colonne B et on attribut la cellule trouvée à C.
   On suppose que C n'est pas Nothing => on fait un certain nombre d'opétation (blablabl;ablalb...)
   Puis, on attribue à C le résultat de FindNext, donc la prochaine cellule contenant le mot clé.
   On arrive à Loop => les 2 conditions sont respectées, donc on effectue à nouveau la boucle à partir de Do.
2. 2ème itération : on cherche le mot clé dans la colonne B et on attribut la cellule trouvée à C.

Et là, c'est le drame !
En effet, on vient juste d'effectuer à nouveau la première recherche. Ou plutôt on attribue à C la recherche sur toute la colonne B. Or toi, ce que tu voulais faire, en utilisant FindNext, c'était de trouver la prochaine occurrence après celle qu'on vient de chercher. Donc en fait, à chaque fois ton C va être la première occurrence du mot clef.

Ce qu'il faudrait faire :

1. Hors de la boucle, faire la première recherche.
2. Commencer la boucle en faisant les opérations (blablablabla) et en finissant avec le FindNext.

Cela donnerait qqc comme cela :

Code :

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

1
2
3
4
5
6
7
8
Set C = Worksheets("KFT results").Columns(2).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
Do
            'Si le mot clé est trouvé
            If Not C Is Nothing Then
                'blablablablablablablablalbblbla
                Set C = Worksheets("KFT results").Columns(2).FindNext(C)
            End If
Loop While Not C Is Nothing And C.Address <> firstAddress

Maintenant, je te conseille de refaire l'exercice où tu exécutes "virtuellement" pas à pas le code pour comprendre en quoi cela est plus fonctionnel.

Oh non ! J'ai dit "plus fonctionnel". ça veut dire que c'est pas encore bon ?
Et non ...

3. Définition de firstAddress

Ici l'erreur est directement reliée à l'erreur précédente. Et peut-être l'as-tu détectée en faisant l'exercice d’exécution "virtuelle" pas à pas.
L'erreur se cache dans le "blablablablabl...", alors réécrivons la boucle en explicitant ce blabla.

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
Set C = Worksheets("KFT results").Columns(2).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
Do        
            'Si le mot clé est trouvé
            If Not C Is Nothing Then
                firstAddress = C.Address
                'On définit le nom de la feuille où sera effectuée la copie
                B = NomFeuille(i)
                With Worksheets(B)
                    'On définit la ligne où sera effectué le collage
                    Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    'On effectue le copier / coller
                    C.EntireRow.Copy .Range("A" & Ligne)
                End With
                Set C = Worksheets("KFT results").Columns(2).FindNext(C)
            End If
Loop While Not C Is Nothing And C.Address <> firstAddress

A chaque itération de la boucle, tu attribus à firstAddress l'adresse de la nouvelle cellule C. Or comme le dit le nom de la variable, ici on veut garder la première adresse trouvée pour détecter le moment où il faut arrêter la boucle. Donc comme pour le premier Find, il faut sortir cela de la boucle pour que ce ne soit pas remis à jour à chaque itération.

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
Set C = Worksheets("KFT results").Columns(2).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
If Not C Is Nothing then firstAddress = C.Address
Do        
            '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
                B = NomFeuille(i)
                With Worksheets(B)
                    'On définit la ligne où sera effectué le collage
                    Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    'On effectue le copier / coller
                    C.EntireRow.Copy .Range("A" & Ligne)
                End With
                Set C = Worksheets("KFT results").Columns(2).FindNext(C)
            End If
Loop While Not C Is Nothing And C.Address <> firstAddress

Et là on devrait être pas trop mal

Tout ceci n'est que pour t'aider à progresser et comprendre qu'elles sont les erreurs dans ton code. Je reste sur ma première position : ce n'est pas le meilleur moyen de faire ce que tu veux faire. Il vaut mieux passer par les filtres. Beaucoup plus rapide.

[TChimie]

Bonjour Riaolle,

Merci beaucoup de ton aide très rapide!
Déjà merci de prendre le temps de tout reprendre pas à pas avec moi, même des notions basiques de forum, j'avoue c'est ma première fois!

Ensuite, j'ai donc fait comme tu me l'a décrit avec l'enregistreur de macro! Et oui je suis désolée mais tu as raison de t'inquiéter de ma manière d'utiliser Excel, à la main j'aurais exactement fait comme tu l'a décrit au début
En tout cas voiàa ce que ça donne avec l'enregistreur de macro (bien "présenté" grâce à toi!):

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
Sub Tri_a_la_main()
'
' Tri_a_la_main Macro
'
 
'
    Range("A1:M28").Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$M$28"), , xlNo).Name = _
        "Tableau2"
    Range("Tableau2[[#Headers],[Colonne2]]").Select
    ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=2, Criteria1:= _
        "Blanc KF four - extrac 600s"
    Range("Tableau2").Select
    Selection.Copy
    Sheets("Blanks").Select
    ActiveSheet.Paste Link:=True
    Sheets("KFT results").Select
    ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=2, Criteria1:= _
        "Contrôle 5,12% Four - extrac 600s"
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Controls").Select
    ActiveSheet.Paste Link:=True
    Sheets("KFT results").Select
    ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=2, Criteria1:= _
        "Analyse eau échantillon avec four - extrac 600s"
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Samples").Select
    Range("A1").Select
    ActiveSheet.Paste Link:=True
End Sub

Mais du coup j'ai plein de questions, comme par exemple si sur un autre fichier de résultat je n'ai pas le même nombre de blanc par exemple, je ne pourrait pas utiliser cette macro car j'ai sélectionné une plage de donnée pour pouvoir la copier/coller...

En tout cas MERCI beaucoup pour ton aide !!

Bonjour et bienvenue dans le forum !

Avant de répondre à ta question :

• Evite d'écrire ta question dans tes discussions "préhistoriques". Il vaut mieux que tu commences une nouvelle discussion quitte à y mettre le lien vers la discussion de laquelle tu t'es inspirée pour ton code.
• Pour "faire apparaitre [ton] code correctement", il faut que tu le mettes entre balises code (pour cela utilise le bouton # dans la barre de menu de la rédaction du message)

Pour la prochaine fois

Ensuite avant de regarder ton code :

Quand je lis "une macro qui me permette de trier mes résultats et de les ranger dans les feuilles suivantes" puis que tu utilises Find avec une boucle, je me dis "aïe"

Pourquoi ?
Avant de penser macro, pensons Excel "à la main". Que ferais-tu pour copier-coller tes données à la main ? Est-ce qu'en colonne B tu cherches la première occurrence de "Blanc", tu copies-colles, puis tu cherches la deuxième occurence, tu copies-colles etc. Oui ? Aïe
Non, il vaut mieux utiliser les filtres !
Alors comment on fait ?

1. On filtre sur "Blanc" en colonne B
2. On copie l'ensemble de la plage obtenue
3. On colle là où on veut.

Si tu n'as pas l'habitude de faire ça à la main, essaie déjà de le faire à la main, puis on va passer en VBA.

Maintenant, comment on fait en VBA ?
On ne se lance pas tout de suite dans le code !
On utilise l'enregistreur de macro et on adapte ce qui en sort.
Déjà essaie cela, puis on continuera

[riaolle]

Pas de panique, on va y aller pas à pas

Avant de voir le code pas à pas, un conseil : il faut éviter les Select/ Activate/ Selection et compagnie. Cela peut vite entraîner des erreurs parce qu'on a oublié qu'on avait sélectionné qqc 10 lignes au-dessus et du coup on comprend pas trop ce qui se passe. Donc, dès que possible on va enlever les Select et cie que nous met l'enregistreur de macro.
Pour cela, il faut que tu te familiarises avec les variables et objets.
Supposons que l'onglet dans lequel sont tes données initiales s'appelle "KFT results" :

Code :

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

1
2
Dim shSource As Worksheet
Set shSource = Worksheets("KFT results")

Maintenant à chaque fois qu'on voudra faire quelque chose dans l'onglet "KFT results", on utilisera shSource pour y faire référence.
Par exemple, si tu veux écrire toto dans la cellule A1 de l'onglet "KFT results", tu écriras :

Code :

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

shSource.Range("A1").Value = "toto"

1. S'adapter à la longueur du tableau

Tu me dis que les tableaux que tu utiliseras n'auront pas toujours le même nombre de ligne. Avec VBA, on va pouvoir chercher la dernière ligne du tableau. En fait, on va plutôt commencer par le bas de la feuille Excel pour remonter vers la dernière ligne remplie de ton tableau. Pour cela, on utilise End.

Code :

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

1
2
Dim derLig As Integer
derLig = shSource.Range("A" & Rows.Count).End(xlUp).Row

Pas à pas :

• Rows.Count : donne le nombre de ligne qu'il y a en tout dans la feuille.
• Donc ARows.Count correspond à la dernière cellule de la colonne A dans la feuille.
• On part de cette cellule et on remonte jusqu'à la première cellule remplie en partant du bas avec End(xlUp) => on a trouvé la dernière ligne de ton tableau.
• On récupère la ligne de cette cellule avec Row.

Maintenant qu'on a cette dernière ligne, on peut écrire la plage de ton tableau :

Code :

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

shSource.Range("A1:M" & derLig)

C'est ça qu'il faudra utiliser quand on créera le tableau :

Code :

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

ActiveSheet.ListObjects.Add(xlSrcRange, shSource.Range("A1:M" & derLig), , xlNo).Name = "Tableau2"

On a dit qu'on aimait pas trop les ActiveSheet et pour rendre le code "plus propre", on va donner un nom "plus propre" au tableau (ça c'est de la déco ) :

Code :

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

shSource.ListObjects.Add(xlSrcRange, shSource.Range("A1:M" & derLig), , xlNo).Name = "tabSource"

2. Nettoyer le code de l'enregistreur

Première chose, à chaque fois qu'on a qqc comme :

Code :

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

1
2
BLABLABLA.Select
Selection.blabla

On va passer à

Code :

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

BLABLABLA.blabla

Et à chaque fois qu'on a des Select qui ne servent à rien parce qu'on les utilise pas après : on les enlève (intelligemment hein )
Et enfin, on va remplacer les ActiveSheet par des références claires aux feuilles concernées.
Tu peux t'exercer de ton côté, puis voici ce que ça donne :

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
Sub Tri_a_la_main()
 
    Dim shSource As Worksheet
    Dim derLig As Integer
 
    Set shSource = Worksheets("KFT results")
    derLig = shSource.Range("A" & Rows.Count).End(xlUp).Row
 
    shSource.ListObjects.Add(xlSrcRange, shSource.Range("A1:M" & derLig), , xlNo).Name = "tabSource"
 
    'filtre sur Blanc
    shSource.ListObjects("tabSource").Range.AutoFilter Field:=2, Criteria1:="Blanc KF four - extrac 600s"   'on filtre
    Range("tabSource").Copy 'on copie le tableau
    Sheets("Blanks").Paste Link:=True   'on colle dans la feuille "Blanks"
 
    'filtre sur Contrôle
    shSource.ListObjects("tabSource").Range.AutoFilter Field:=2, Criteria1:="Contrôle 5,12% Four - extrac 600s"
    Range("tabSource").Copy
    Sheets("Controls").Paste Link:=True
 
    'filtre sur échantillon
    shSource.ListObjects("tabSource").Range.AutoFilter Field:=2, Criteria1:="Analyse eau échantillon avec four - extrac 600s"
    Range("tabSource").Copy
    Sheets("Samples").Paste Link:=True
End Sub

3. Sécuriser les Copy/Paste
En fait, avec Paste, Excel va coller dans la cellule active de la feuille. C'est un peu dangereux si la cellule active n'est pas celle qu'on veut. Personnellement, je n'aime pas trop utiliser la fonction Paste. Je préfères utiliser seulement Copy en ajoutant une destination. En plus, ça ne fait plus qu'une seule ligne de code

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
Sub Tri_a_la_main()
 
    Dim shSource As Worksheet
    Dim derLig As Integer
 
    Set shSource = Worksheets("KFT results")
    derLig = shSource.Range("A" & Rows.Count).End(xlUp).Row
 
    shSource.ListObjects.Add(xlSrcRange, shSource.Range("A1:M" & derLig), , xlNo).Name = "tabSource"
 
    'filtre sur Blanc
    shSource.ListObjects("tabSource").Range.AutoFilter Field:=2, Criteria1:="Blanc KF four - extrac 600s"   'on filtre
    Range("tabSource").Copy Destination:=Sheets("Blanks").Range("A1")
 
    'filtre sur Contrôle
    shSource.ListObjects("tabSource").Range.AutoFilter Field:=2, Criteria1:="Contrôle 5,12% Four - extrac 600s"
    Range("tabSource").Copy Destination:=Sheets("Controls").Range("A1")
 
    'filtre sur échantillon
    shSource.ListObjects("tabSource").Range.AutoFilter Field:=2, Criteria1:="Analyse eau échantillon avec four - extrac 600s"
    Range("tabSource").Copy Destination:=Sheets("Samples").Range("A1")
End Sub

Voilà, voilà !
J'ai testé chez moi, normalement ça fonctionne

[TChimie]

Bonjour Riaolle,

Merci pour ton message et du temps que tu prends pour me guider pas à pas. J'ai pris du temps mais j'ai voulu faire chaque étape et comprendre où on va avant de relancer des questions, d'où ma lenteur!

Déjà, niveau maternelle de VBA sans doute mais:
Pourquoi lorsque l'on renomme la feuille où sont les données initiales on ne la nomme pas directement "KFT results" mais shSource? Et après on utilise bien par exemple Sheets("Blanks") pour la destination du copier donc pourquoi avoir eu besoin de renommer la feuille des données sources?
Ensuite, j'avais souhaiter coller avec liaison les données mais j'ai l'impression que si je fais copier avec la destination je ne peux pas mettre la liaison, c'est correct?

Maintenant, ce que j'avais essayé d'anticiper au tout début, d'où le choix de l'utilisation de Find avec mot clé, c'est que dans l'avenir je vais avoir différentes méthodes utilisées pour mes mesures qui apparaitront dans ma colonne B. Par exemple "Contrôle 5,12% Four - extrac 600s" mais aussi "Contrôle 1% Four - extrac 600s" ou encore "Contrôle 5,12% Four - extrac 300s". C'est toujours le même type d'analyse, pour cet exemple toujours des contrôles mais dosés différemment ou avec un temps d'extraction plus court mais qui doivent tous être copier dans ma feuille "Controls". (Ce sera le cas également pour les Blancs et les échantillons.) Si j'avais choisi les mots clés "Blanc", "Contrôle" et "échantillon" c'est parce que ces mots clé apparaissent selon les méthodes. Ce que j'ai trouvé avec le dernier code sur lequel on a travaillé c'est de le modifier ainsi:

Code :

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

1
2
 shSource.ListObjects("tabSource").Range.AutoFilter Field:=2, Criteria1:="Contrôle 5,12% Four - extrac 600s" , Criteria2:= "Contrôle 5,12% Four - extrac 300s", Criteria3:= "Contrôle 1% Four - extrac 300s"
    Range("tabSource").Copy Destination:=Sheets("Samples").Range("A1")

Mais du coup je dois connaitre tous les noms des méthodes pour pouvoir les intégrer au code avant, c'est possible mais j'avais espéré éviter cette étape

Quoi qu'il en soit pour le moment je suis ravie de ce que tu as fait pour moi, il faut que je prenne plus de temps pour comprendre la "structure " du VBA, d'ailleurs merci beaucoup pour les liens que tu mets dans tes réponses, je n'ai plus qu'à cliquer pour savoir de quoi tu parles, c'est hyper pédagogique pour moi! En tout cas pour le moment le tri de mes données n'ai plus une corvée, grâce à toi!

[riaolle]

1er point : sur les feuilles
Si, on peut tout à fait faire ce que tu dis. Les 2 codes suivants sont équivalents :

Code :

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

1
2
3
Dim sh As Worksheet
Set sh = Sheets("Feuil1")
sh.Range("A1").Value = "toto"

et

Code :

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

Sheets("Feuil1").Range("A1").Value = "toto"

C'est juste que quand dans un code j'utilise plusieurs fois la même feuille, j'aime bien lui donner un nom d'objet, surtout quand le nom de la feuille est un peu long. Mais rien ne t'empêche de garder le nom de la feuille

2ème point : possibilité d'avoir des évolutions dans les recherches
Pas de problème ! Je préfère toujours utiliser la méthode avec le filtre, car tu peux faire un filtre sur les lignes "qui contiennent ...".
Donc si tu dis que tu veux filtrer sur les lignes qui commencent par le mot "Contrôle", tu peux faire :

Code :

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

shSource.ListObjects("tabSource").Range.AutoFilter Field:=2, Criteria1:="Contrôle*"

Si tu veux filtrer sur les lignes qui contiennent le mot "contrôle", tu fais :

Code :

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

shSource.ListObjects("tabSource").Range.AutoFilter Field:=2, Criteria1:="*contrôle*"

En fait, les * sont une sorte de joker pour dire qu'on peut mettre ce qu'on veut à l'endroit de l'étoile.

[Kikouyou]

Bonjour, Code intéressant mais la ligne "Loop While Not C Is Nothing And C.Address <> firstAddress" ne passe pas... une idée ?