Recherche aide pour incrémanter une boucle dans code VBA

Question

Bonjour a tous :),

je me remet un peux sur VBA mais j'ai toujours eu des souci avec les boucles :(, voici ce que je voudrais faire exactement:

Sur une feuille je voudrais rechercher des X dans une colonne si il y a présence d'un x je voudrais qu'il me copie la ligne sur une autre feuille et ainsi de suite ci dessous mon code simple mais je ne sais pas comment incrémenter une boucle pour qu'une fois le 1er x trouver il continue sa recherche, merci pour votre aide :)

Dim L1, L2, L3
Dim cell
Dim r

Data = "x"

Sheets.Add.Name = "Recherche Devis a faire"
Sheets("SUIVI VTL").Select

'recherche de la la croix "x" dans la colonne CU
For Each cell In Range(Cells(1, 99), Cells(65000, 99))
If cell.Value = Data Then
L1 = cell.Row
L3 = cell.End(xlUp).Row
Range("A1").Value = cell.Row
r = Cells(65536, 99).End(xlUp).Row
Range("B1").Value = L3

'Copy de la ligne avec "x" dans la page de ==> Recherche Devis a faire

Rows(L1).Select
    Selection.Copy
    Sheets("Recherche Devis a faire").Select
    
If Range("A1") = "" Then
    Rows("1:1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End If

Exit For

End If

jordane45 · Answer

Bonjour. 
Il y a certainement d'autres choses à regarder dans ton code mais déjà
Pense que For va avec Next.

ThCinfo · Answer

Bonjour,

je ne suis pas un expert en la matière, mais voici comment je procèderais, le plus simplement possible :

    ' l'on considère que la recherche se fait
    ' dans l'onglet 1, et la copy dans l'onglet 2
    '
    ' la colonne CU est la 99ième
    '
    ' l'on considère qu'une colonne est toujours remplie
    ' ici la 1ère (si vide la boucle s'arrête)

code 1 : limite de recherche à la ligne n° 1 000

Sub Recherche_Devis_a_faire()

Dim ThClect As String, _
        ThCcherche As String

Dim ThCboucl As Integer, _
        ThCcopy As Integer
    
    ThCcopy = 1
    ThCcherche = "x"
    
        For ThCboucle = 1 To 1 000
            If Sheets(1).Cells(ThCboucle, 1) = "" Then Exit For
            If Sheets(1).Cells(ThCboucle, 99) = ThCcherche Then
                        Rows(ThCboucle).Select
                        Selection.Copy
                        Sheets(2).Rows(ThCcopy).PasteSpecial
                        ThCcopy = ThCcopy + 1
                End If
        Next ThCboucle

End Sub



  ou code 2 : recherche non limité au n° de ligne.

Sub Recherche_Devis_a_faire()

Dim ThClect As String, _
        ThCrecherch As String

Dim ThCboucl As Integer, _
        ThCcopy As Integer
    
    ThCcopy = 1
    ThCboucl = 1
    ThCcherche = "x"

Do
            ThClect = Sheets(1).Cells(ThCboucl, 1)
                If Sheets(1).Cells(ThCboucl, 99) = ThCcherche Then
                        Rows(ThCboucl).Select
                        Selection.Copy
                        Sheets(2).Rows(ThCcopy).PasteSpecial
                        ThCcopy = ThCcopy + 1
                End If
            ThCboucl = ThCboucl + 1
        Loop While ThClect <> ""

End Sub

à ajuster évidemment.

.

jordane45 · Answer

Bonsoir,

Pour réaliser ce que tu souhaites faire... il y a plus rapide que les boucles (sur Excel) il y a les Filtres.

1 - Premier Onglet, tu filtres pour ne garder QUE les lignes contenant des "X"

Function AutoFilterOn(Nom_Feuille As String, Nom_range As Range)
' Active la feuille concernée
 Sheets(Nom_Feuille).Activate
' Vérifie si un filtre existe, si non.. active le mode filtre
 If Not ActiveSheet.AutoFilterMode Then
 ActiveSheet.Range(Nom_range).AutoFilter
 End If
End Function

Appliquer le filtre sur le caractère voulu

Function AutoFilterOn(Nom_Feuille As String, Nom_range As String, charFiltre As String, NumField As Integer)
'--------------------------------------
'Activer le mode Filtre automatique
'--------------------------------------
'NumField : N° colonne où filtrer
'charFiltre : caractère recherché
' Active la feuille concernée
 Sheets(Nom_Feuille).Activate
' Vérifie si un filtre existe, si non.. active le mode filtre
 If Not ActiveSheet.AutoFilterMode Then
 ActiveSheet.Range(Nom_range).AutoFilter Field:=NumField, Criteria1:=charFiltre
End If
End Function

' Exemple d'utilisation :
Sub Macro1()
    ' Lance le filtre :
    Fi = AutoFilterOn("Feuil1", "$A$1:$A$12", "z", 1)
End Sub

2 - Tu copies ces lignes dans ton autre feuille :

'Copier les données filtrées
Function Copie_Result_Filtre(NomFeuille1 As String, NomFeuille2 As String) As Boolean
'NomFeuille1 = Feuille contenant les données filtrées
'NomFeuille2 = Feuille qui recevra les données
 Sheets(NomFeuille1).Activate
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets(NomFeuille2).Select
 ActiveSheet.Paste
 Application.CutCopyMode = False

'---------------------------------------
' Enlever la fenêtre de selection
 ActiveSheet.Range("A1").Select
 Sheets(NomFeuille1).Activate
 ActiveSheet.Range("A1").Select
'---------------------------------------
End Function


EDIT : Code corrigé.
 
Cordialement,
Jordane

us_30 · Answer

Bonjour,

"je ne sais pas comment incrémenter une boucle pour qu'une fois le 1er x trouver il continue sa recherche"

Ben, il te manque un NEXT quelque part, comme le dit jordane...
La boucle "FOR EACH" se referme avec l'instruction "NEXT" pour passer à l'élément suivant. De plus, ton code ne semble pas correcte pour la recherche dans FOR EACH, mais bon...

Voilà.

Amicalement,
Us.

Recherche aide pour incrémanter une boucle dans code VBA

4 réponses

Votre réponse