[VBA] Accélérer ma macro

Salut les gens!

Je me permets de venir vers vous avec un bout de code.

La petite histoire : je suis en train de créer un fichier excel pour gérer un tournoi par poule.

Selon le nombre de participants, le fichier crée une feuille par poule et apparie les joueurs.

A l'issue des parties, j'ai besoin de créer un classement global pour lancer les phases finales (j'y suis pas encore). Donc, le bout de code en question doit permettre d'aller chercher le classement dans chaque poule, le copier et l'ajouter sur la feuille "Classement", à la suite des lignes précédemment copiées.

La bonne nouvelle, c'est que mon code marche parfaitement. Bon, il est optimisable (une MsgBox demandant le nombre de poules?), mais je n'avais jamais touché à du VBA avant ces 15 derniers jours.

Merci, d'ailleurs, à l'ensemble des personnes du forum, car j'ai trouvé beaucoup de réponses à mes interrogations.

Le principal problème, comme l'indique le titre, c'est que ce code est lent :

Sub test()
    Sheets.Add(After:=Worksheets(Worksheets.count())).Name = "Classement"
    A = Worksheets("DB").Range("I2")
    If A = 12 Or A = 18 Then
        B = 3
    Else
        If A = 16 Or A = 24 Or A = 32 Then
            B = 4
        Else
            If A = 20 Or A = 30 Or A = 30 Then
                B = 5
            Else
                If A = 36 Then
                    B = 6
                Else
                    If A = 42 Then
                        B = 7
                    Else
                        If A = 48 Then
                            B = 8
                        Else
                            B = 0
                        End If
                    End If
                End If
            End If
        End If
    End If
    For i = 1 To B
        n = 0
        For Each Cell In Sheets("Classement").Columns(2).Cells
            If Not IsEmpty(Cell) Then n = n + 1
        Next Cell
        m = n + 1
        Sheets("Poule 0" & i).Range("O2:Q7").Copy Destination:=Sheets("Classement").Range("B" & m)
    Next
End Sub

Après différents tests, j'ai isolé la partie lente :

n = 0
        For Each Cell In Sheets("Classement").Columns(2).Cells
            If Not IsEmpty(Cell) Then n = n + 1
        Next Cell
        m = n + 1

Une âme charitable pour m'apporter une solution?

Bonjour,

C'est long parce que pour chaque ligne à copier on redétermine la première ligne libre à l'aide d'une boucle.

On pourrait utiliser:

    m = WorkSheets("Classement").Range("B" & Rows.Count).End(xlUp).Row  'dernière ligne occupée
    For i = 1 To B
        m = m + 1
        Sheets("Poule 0" & i).Range("O2:Q7").Copy Destination:=Sheets("Classement").Range("B" & m)
    Next

A+

Merci! Ton code marche nettement mieux que le mien.

J'ai juste appliquer la modification suivante :

For i = 1 To B
        m = Worksheets("Classement").Range("B" & Rows.count).End(xlUp).Row  'dernière ligne occupée
        m = m + 1
        Sheets("Poule 0" & i).Range("O2:Q7").Copy Destination:=Sheets("Classement").Range("B" & m)
        MsgBox ("Copie faite")
    Next

car le tien déterminait le "m" en dehors de la boucle et la boucle ne prenait pas vraiment en compte la dernière ligne occupée.

...le tien déterminait le "m" en dehors de la boucle et la boucle ne prenait pas vraiment en compte la dernière ligne occupée.

ça ne fonctionne pas ou tu imagines que ça ne va pas fonctionner ?

As tu tester avant de modifier ?

Selon le code proposé :

Si on détermine la dernière ligne occupée en dehors de la boucle , par exemple m= 5

s'il y a 3 itérations pour i (par exemple)

à la première itération m=m+1 donc 6 on écrit bien à la première ligne vide (la ligne 6 devient la dernière occupée)

à la 2ème : m=m+1 donc 7 , on écrit bien sur la ligne 7 qui est vide (la ligne 7 devient la dernière occupée)

à la 3ème : m=m+1 donc 8 , on écrit bien sur la ligne 8 qui est vide (la ligne 8 devient la dernière occupée)

Selon ton code :

s'il y a 3 itérations pour i (par exemple)

à la première itération dernière ligne= 5 (par exemple) m=m+1 donc 6 on écrit bien à la première ligne vide (la ligne 6 devient la dernière occupée)

à la 2ème :dernière ligne= 6, m=m+1 donc 7 , on écrit bien sur la ligne 7 qui est vide (la ligne 7 devient la dernière occupée)

à la 3ème :dernière ligne= 7, m=m+1 donc 8 , on écrit bien sur la ligne 8 qui est vide (la ligne 8 devient la dernière occupée)

La seule différence c'est qu'avec ton code on perd du temps à rechercher la dernière ligne à chaque itération

Avant de modifier, j'ai testé.

Avec ta version, dans le cas de trois itérations de i, m=1, et 4 lignes à copier à chaque itération, je n'avais, après lancement de la macro que 6 lignes, chaque itération après la première ayant écrasé les 3 dernières lignes...

Je sais pas si je suis clair...

Edit :

Aaah OK , je n'avais pas vu qu'on copiait 6 lignes à chaque fois

ça deviendrait pour éviter la recherche de la dernière ligne à chaque fois:

    m = WorkSheets("Classement").Range("B" & Rows.Count).End(xlUp).Row + 1 'première ligne libre
    For i = 1 To B
        Sheets("Poule 0" & i).Range("O2:Q7").Copy Destination:=Sheets("Classement").Range("B" & m)
        m = m + 6 ' à adapter au nombre de lignes copiée 
    Next

Cool! Encore merci pour tes réponses rapides!

Jamais déçu sur ce forum!!