Posez votre question Signaler

Recherche aide pour incrémanter une boucle dans code VBA

Messages postés
36
Date d'inscription
lundi 29 janvier 2007
Statut
Membre
Dernière intervention
17 janvier 2017
 - - Dernière réponse : us_30
Messages postés
2065
Date d'inscription
lundi 11 avril 2005
Statut
Membre
Dernière intervention
14 mars 2016
 - 8 déc. 2013 à 20:29
VBA Office (Excel, Word ...) Posez votre question Signaler
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
Afficher la suite 

4 réponses

Meilleure réponse
Signaler Commenter la réponse de ThCinfo
Messages postés
2
Date d'inscription
mardi 3 décembre 2013
Statut
Membre
Dernière intervention
3 décembre 2013
 1
1
Merci
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.

.

Dire « Merci » 1

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 205 internautes nous ont dit merci ce mois-ci

Signaler Commenter la réponse de ThCinfo
ThCinfo
Messages postés
2
Date d'inscription
mardi 3 décembre 2013
Statut
Membre
Dernière intervention
3 décembre 2013
 1 -
Houps !

J'ai noté une faute :
- ' dans l'onglet 1, et la copy dans l'onglet 2
- copy s'écrit copie

plus une erreur de frappe dans le code 2 :

- ThCrecherch As String
est plutôt
- ThCrecherche As String

je rajoute ce commentaire car je n'ai pas trouvé comment corriger ces erreurs.

.
Commenter la réponse de ThCinfo
Signaler Commenter la réponse de jordane45
Messages postés
26782
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
17 novembre 2019
 317
1
Merci
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

Dire « Merci » 1

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 205 internautes nous ont dit merci ce mois-ci

Commenter la réponse de jordane45
Signaler Commenter la réponse de jordane45
Messages postés
26782
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
17 novembre 2019
 317
0
Merci
Bonjour.
Il y a certainement d'autres choses à regarder dans ton code mais déjà
Pense que For va avec Next.

Commenter la réponse de jordane45
Signaler Commenter la réponse de us_30
Messages postés
2065
Date d'inscription
lundi 11 avril 2005
Statut
Membre
Dernière intervention
14 mars 2016
 7
0
Merci
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.
Commenter la réponse de us_30
Répondre Posez votre question