VBA - Conditions boucle: Nombre de ligne dans une selection

Bonjour à tous,

je construit une macro dont les principales étapes sont les suivantes:

• J'ai un fichier de plusieurs factures qui sont compilées
• Je les copie/colle dans un onglet afin de les isoler (dans le but de les envoyer par mail par la suite)
• C'est grace à une boucle que je vais pouvoir efefctuer cette opération

Je n'arrive pas à rédiger la condition de ma boucle.

Je souhaite que

-Si la sélection contient plus de 1000 lignes alors la boucle s'arrête.

Je pense que cette fonction serai la plus adapéte:

Sub boucle_do_while()

    Do

        'Instructions

    Loop While [condition]

End Sub

Merci d'avance pour votre aide,

Tom

bonjour

une solution possible

i=1
do
'instructions
i=i+1
do while i<1000

Bonjour H2so4,

merci pour ta réponse.

Je l'ai intégrée à mon code ce qui me donne ceci:

i = 1
    Do

    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 11)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    Columns("A:A").Delete Shift:=xlToLeft
    Cells(16384, 1).End(xlUp).Select
    Selection.ClearContents
    Cells(16384, 3).End(xlUp).Select
    Selection.ClearContents
    Sheets("Extraction Logiroute").Select
    Selection.End(xlDown).Select

    i = i + 1

    Do While i < 1000

L'erreur suivante apparait: "'Erreur de compilation: Do sans boucle"

Ou me suis-je planté stp???

Bonjour,

c'est moi qui me suis planté

il faut terminer la boucle par une instruction loop et non do.

donc

i = 1
    Do

    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 11)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    Columns("A:A").Delete Shift:=xlToLeft
    Cells(16384, 1).End(xlUp).Select
    Selection.ClearContents
    Cells(16384, 3).End(xlUp).Select
    Selection.ClearContents
    Sheets("Extraction Logiroute").Select
    Selection.End(xlDown).Select

    i = i + 1

    loop While i < 1000

Cette fois ci il n'y a pas d'erreur mais la boucle tourne encore à l'infinit alors qu'il y a pourtant une selection dont + de 1000 lignes sont concernées (Enfait cette sélection commence de la dernière facturation du fichier et atteint la dernière ligne du classeur: 108576)

Comprend pas :'(

Si tu mettais ton fichier et des explications du résultat que tu veux obtenir ?

Voici une partie du fichier.

Je souhaite que chacun des bloc vert (= une préfac) soit extraite dans un nouvel onglet. Jusque là c'est bon.

Etant donné que je vais avoir une centaine de bloc vert. Je souhaite que mon code (que j'ai donné tout à l'heure) soit répété en boucle.

Le problème est que je n'arrive pas à écrire de condition pour arrêter la boucle quand la dernière facture est extraite.

Dis moi si tu as besoin de + d'infos.

Encore merci

Bonjour,

une proposition

Sub aargh()
    Set ws = Sheets("extraction logiroute v1")
    'on recherche une ligne qui contient "Votre REF"
    Set pl = ws.Columns(3).Find("Votre REF")
    pl1 = pl.Row 'numéro de première ligne dans pl1
    'on recherche la ligne suivante contenant "Votre REF"
    Set pl = ws.Columns(3).FindNext(pl)
    pl2 = pl.Row 'numéro de ligne suivante dans pl2
    While pl1 < pl2 ' tant que pl1 plus petit que pl2
        Sheets.Add after:=Sheets(Sheets.Count) 'on ajoute un feuille
        ws.Range(ws.Cells(pl1, "C"), ws.Cells(pl2 - 2, "M")).Copy Range("A1") 'on copie la pre-fac
        pl1 = pl2 'numéro de première ligne = ligne suivante
        'on recherche la ligne suivante qui contient "votre REF"
        Set pl = ws.Columns(3).FindNext(pl)
        ' numéro de ligne suivante dans pl2
        pl2 = pl.Row
    Wend ' on boucle
        pl2=ws.cells(rows.count,1).end(xlup).row
        Sheets.Add after:=Sheets(Sheets.Count) 'on ajoute un feuille
        ws.Range(ws.Cells(pl1, "C"), ws.Cells(pl2 , "M")).Copy Range("A1") 'on copie la pre-fac
End Sub

Merci pour ce code qui fonctionne très bien!

Un seul hic: La dernière prefac n'est pas prise en compte car il n'y pas a de "Votre Ref" en dessous.

As-tu une sollution?

re-Bonjour,

Sub aargh()
    Set ws = Sheets("extraction logiroute v1")
    'on recherche une ligne qui contient "Votre REF"
   Set pl = ws.Columns(3).Find("Votre REF")
    pl1 = pl.Row 'numéro de première ligne dans pl1
   'on recherche la ligne suivante contenant "Votre REF"
   Set pl = ws.Columns(3).FindNext(pl)
    pl2 = pl.Row 'numéro de ligne suivante dans pl2
   While pl1 < pl2 ' tant que pl1 plus petit que pl2
       Sheets.Add after:=Sheets(Sheets.Count) 'on ajoute un feuille
       ws.Range(ws.Cells(pl1, "C"), ws.Cells(pl2 - 2, "M")).Copy Range("A1") 'on copie la pre-fac
       pl1 = pl2 'numéro de première ligne = ligne suivante
       'on recherche la ligne suivante qui contient "votre REF"
       Set pl = ws.Columns(3).FindNext(pl)
        ' numéro de ligne suivante dans pl2
       pl2 = pl.Row
    Wend ' on boucle
       pl2=ws.cells(rows.count,1).end(xlup).row
        Sheets.Add after:=Sheets(Sheets.Count) 'on ajoute un feuille
       ws.Range(ws.Cells(pl1, "C"), ws.Cells(pl2 , "M")).Copy Range("A1") 'on copie la pre-fac
End Sub