Discussion :

[chammos]

une boucle qui tourne et débogue après la 1ère variable trouvées copie les données de la 1 ère recherche mais lorsqu'il passe pour la 2ème recherche ne prend pas la 2ème variable du tableau comme élément de recherche
voilà le code que j'utilise et merci d'avance pour votre aide

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
Sub test1()
 
Dim c As Range
Dim flag As Boolean
Dim Nom As Variant
Dim i&
 
Sheets("Brut").Select
 
'*************Copy données text1 dans feuille Data***********
    Nom = Array("text1", "text2", "text4", "text4", "text5)")
    Application.ScreenUpdating = False
   For i& = LBound(Nom) To UBound(Nom)
    For Each c In ActiveSheet.UsedRange
        If c.Value = Nom(i&) Then
            flag = True
            Exit For
        End If
    Next
       Range(c.Address).Select   ' pour recherche text1 c'est bon mais lorsqu'il cherche text2 s’arrête sur cette ligne 
       ActiveCell.Offset(0, 1).Select
       Range(Selection, Selection.End(xlDown)).Cut
 
Sheets("Data").Select
 
          Cells(2, i& + 2).Select
          ActiveSheet.Paste
 
 
Sheets("Brut").Select
 
Application.CutCopyMode = False
 
Next i&
 
End Sub

[BENNASR]

bonsoir
Peut être une réponse en hors jeu vu mon niveau en VBA
mais si tu supprime ce exit for en ligne 17 ?? je crois que tu demande sortir de ma boucle une fois trouve une valeur non ??

Code :

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

1
2
3
4
5
6
7
For i& = LBound(Nom) To UBound(Nom)
    For Each c In ActiveSheet.UsedRange
        If c.Value = Nom(i&) Then
            flag = True
            'Exit For ' à supprimer cette ligne
        End If
    Nextr

[Patrice740]

Bonjour,

Essaies :

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
Sub test1()
Dim f As Worksheet
Dim c As Range
Dim flag As Boolean
Dim Nom As Variant
Dim i&
  Set f = Worksheets("Brut")
  Nom = Array("text1", "text2", "text3", "text4", "text5)")
  Application.ScreenUpdating = False
  For i = LBound(Nom) To UBound(Nom)
    For Each c In f.UsedRange
      If c.Value = Nom(i) Then
        flag = True
        Exit For
      End If
    Next
    If flag Then
      Set c = c.Offset(0, 1)
      f.Range(c, c.End(xlDown)).Cut Worksheets("Data").Cells(2, i + 2)
    End If
  Next i
  Application.ScreenUpdating = True
End Sub

[Menhir]

Il peut y avoir une explication simple : le texte du second item n'est pas trouvé.

Sinon, pour ton 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
Sub test1()
   Dim c As Range
   Dim Nom As Variant
   Dim i As Long
 
   Sheets("Brut").Activate
   Nom = Array("text1", "text2", "text3", "text4", "text5")
 
   For i = LBound(Nom) To UBound(Nom)
      c = ActiveSheet.UsedRange.Find(Nom(i))
      If Not c Is Nothing Then
         Range(c.Offset(0, 1), c.Offset(0, 1).End(xlDown)).Cut
       Sheets("Data").Cells(2, i + 2).PasteSpecial(xlPasteAll)
   Next i
 
End Sub

pour recherche text1 c'est bon mais lorsqu'il cherche text2 s’arrête sur cette ligne

Quel est le message d'erreur renvoyé ?

[MarcelG]

Si je peux me permettre.

Set c =

[Menhir]

Tu as raison.
J'ai oublié de préciser que je n'avais pas testé ce code et qu'il est probable qu'un peu de débugage soit nécessaire.

[chammos]

 

Merciiiiiiiiiiiiiiiiii c'est ok ça tourne bien

[MarcelG]

Salut,

Je me permets, Menhir

Le mesage d'erreur devrait être
"Variable Objet ou variable de bloc With non définie"
(91)
En effet, c est déclarée comme variable Range d'où la méthode Set pour l'affecter.

Le code corrigé

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
Option Explicit
 
Sub test1()
 
Dim c As Range
Dim Nom As Variant
Dim i As Long
 
Sheets("Brut").Activate
Nom = Array("text1", "text2", "text3", "text4", "text5")
 
For i = LBound(Nom) To UBound(Nom)
   Set c = ActiveSheet.UsedRange.Find(Nom(i))
   If Not c Is Nothing Then
        Range(c.Offset(0, 1), c.Offset(0, 1).End(xlDown)).Cut
        Sheets("Data").Cells(2, i + 2).PasteSpecial (xlPasteAll)
        Application.CutCopyMode = False
    End If
    Set c = Nothing
Next i
 
End Sub

[Menhir]

J'avais aussi oublié un End If.