Bug après la 1ère variable trouvées

Version imprimable

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:

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

bonsoir
Peut être une réponse en hors jeu vu mon niveau en VBA :aie:
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:

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

Bonjour,

Essaies :

Code:

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

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

Sinon, pour ton code :
Code:

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
Citation:

Envoyé par chammos

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

Quel est le message d'erreur renvoyé ?

19/11/2018, 18h06
MarcelG

Si je peux me permettre.

Set c =
20/11/2018, 09h07
Menhir

Tu as raison. :plusser:
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.
22/11/2018, 13h02
chammos

Merciiiiiiiiiiiiiiiiii c'est ok ça tourne bien

Citation:

Envoyé par Menhir

Merciiiiiiiiiiiiiiiiii c'est ok ça tourne bien

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:

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

23/11/2018, 09h39
Menhir

J'avais aussi oublié un End If.