Copier coller de ligne d'un tableau à un autre optimisation

[macadamx]

Bonjour à tous !

J'ai codé ceci :

Sub mesures_en_cours()

'séléction de la feuille et analyse des lignes puis copie si concordance
Sheets("game").Select
Range("A1").Select
Do While ActiveCell.Value <> ""
If ActiveCell.Value = "en cours" Then
ActiveCell.EntireRow.Select
Selection.Copy
Sheets("MESURES EN COURS").Activate

'vérification que la ligne est vide => collage sinon voir bloc du dessous
If ActiveCell.Offset(1, 0).Value = "" Then
Selection.Insert
Sheets("game").Select
ActiveCell.Offset(1, 0).Select

'descente jusqu'à la première ligne vide et collage
Else
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.Insert
Sheets("game").Select
ActiveCell.Offset(1, 0).Select
End If

Else
ActiveCell.Offset(1, 0).Select
End If

Loop
'séléction de ma feuille de données
Sheets("game").Select

End Sub

Mais je trouve le temps d'éxécution un peu long car cela analyse plus de 700 lignes.
Auriez vous une idée pour optimiser mon code et raccourcir le temps d'éxécution ?

 

[Modeste]

Re : Copier coller de ligne d'un tableau à un autre optimisation

Bonjour macadamx,

En devenant lecteur assidu de ce forum (entre autres) tu ne pourras pas manquer de lire que les '.Select' sont à proscrire, dans la mesure où, précisément, ils ralentissent l'exécution du code!

Si l'objectif de ta macro est simplement de recopier, de la feuille "game" à la feuille "mesures en cours", les lignes contenant "en cours" en colonne A, alors oui, on peut certainement faire plus "concis".

Pour pouvoir faire une proposition, le mieux serait que tu fournisses un extrait (sans données confidentielles!) de ton fichier (ou un fichier exemple avec des données "bidon", pour autant qu'il représente la situation réelle). Ça permettra de tester une solution, avant de la soumettre et de bien comprendre ton souci.

 

[macadamx]

Re : Copier coller de ligne d'un tableau à un autre optimisation

Bonjour Modeste,

Voici le fichier anonymisé et volontairement raccourci.
Les colonnes allant jusqu'à BK et les lignes jusqu'à plus de 800

Merci de votre réponse.

Johan

 

[Modeste]

Re : Copier coller de ligne d'un tableau à un autre optimisation

Re-bonjour, macadamx et Johan,

Un doute m'assaille (comme diraient les guerriers kenyans du même nom): les titres des colonnes ne sont pas identiques dans les deux feuilles ... c'est juste une erreur en prépérant le fichier exemple?? Parce que si on copie les lignes entières et que les contenus ne correspondent pas, tu vas être mal

 

[macadamx]

Re : Copier coller de ligne d'un tableau à un autre optimisation

Re-bonjour,

C'est juste une erreur

 

[Modeste]

Re : Copier coller de ligne d'un tableau à un autre optimisation

Re²,

Alors, essaye ce code (à coller dans un module standard):

Sub EnCours()
    Application.ScreenUpdating = False
    Set cible = Sheets("MESURES EN COURS")
    cible.[A2].Resize(Application.CountA(cible.[B:B]), Application.CountA(cible.[1:1])).ClearContents
    With Sheets("game")
        For Each c In .[A2].Resize(Application.CountA(.[B:B]) - 1, 1)
            If c = "en cours" Then c.EntireRow.Copy cible.[A50000].End(xlUp).Offset(1, 0)
        Next c
    End With
    Application.ScreenUpdating = True
End Sub

... et reviens-nous dire si tu as des questions ou s'il y a encore des lenteurs (on pourrait travailler avec un filtre, pour copier "en un bloc" les résultats, ou travailler avec un tableau en mémoire, si le volume des données était "conséquent")

 

[macadamx]

Re : Copier coller de ligne d'un tableau à un autre optimisation

Ouah ! ça marche niquel !

Merci beaucoup ! ! !
Peux tu fais quelques commentaires rapide s'il te plaît sur le code comme ça je peux comprendre et le modifier et réutiliser par la suite.

Encore merci !

 

[Modeste]

Re : Copier coller de ligne d'un tableau à un autre optimisation

Re²,

Nickel ... sur l'extrait de ton fichier (qui ne compte qu'une douzaine de lignes), ça devrait aller ... c'est sur ton vrai fichier que le test sera déterminant!

Quant à faire des commentaires sur mon code ... tu prends mon pseudo en défaut, mais bon ... le code est élégant et racé, il a du corps et le bouquet rappelle les meilleurs. Il est encore un peu jeune, mais prometteur, etc.

Quoi, pas ces commentaires-là!? ... Ah ben mince!

Sub EnCours()
    Application.ScreenUpdating = False 'évite le rafraîchissement de l'écran pendant l'exécution
    Set cible = Sheets("MESURES EN COURS") 'ça, ça va?
    'à la ligne suivante, Application.CountA correspond à NBVAL. Permet de définir une sélection (resize) au départ de A2,
    'comprenant le nombre de lignes et de colonnes et d'effacer le contenu
    cible.[A2].Resize(Application.CountA(cible.[B:B]), Application.CountA(cible.[1:1])).ClearContents
    With Sheets("game") 'pour ne pas l'écrire à chaque fois
        For Each c In .[A2].Resize(Application.CountA(.[B:B]) - 1, 1) 'pour chaque cellule de la plage qui s'étend de
        'A2 à la dernière cellule de cette même colonne A, de la feuille "game"
            
            'ligne suivante: "cible.[A50000].End(xlUp).Offset(1, 0)" au départ de A50000 et en remontant, on "pointe" sur
            'la dernière cellule non-vide et on décale d'une ligne
            If c = "en cours" Then c.EntireRow.Copy cible.[A50000].End(xlUp).Offset(1, 0)
        Next c
    End With
    Application.ScreenUpdating = True
End Sub

Pour chaque mot-clé dans le code (Offset, With, Resize, ...) n'oublie pas que tu peux positionner le curseur dessus et appuyer sur la touche F1

 

[macadamx]

Re : Copier coller de ligne d'un tableau à un autre optimisation

Merci, cela me permet d'une de reprendre ce type de formules et de deux, aux prochaines personnes de comprendre comment appliquer cela à leur propre cas de figure !