Arrêt de boucle et "clignotement" VBA

Bonjour ou rebonjour tout le monde !

Je poste aujourd'hui sur le forum concernant un petit problème que j'ai concernant un code VBA.

J'ai créé le code ci-dessous, qui permet de prendre des valeurs d'un classeur pour les recopier dans un autre classeur, dans différentes cellules. Jusque là tout va bien. Or le problème, c'est que je ne trouve pas comment je peux lui dire que, dès lors que les toutes les sélections concernent des cellules vides, la boucle s'arrête. C'est tout bête je pense, mais je n'arrive pas à trouver. Si jamais vous avez la solution, ça me rendrait énormément service.

Question subsidiaire, mais ô combien importante pour le confort d'utilisation de mon outil : à chaque étape, on voit le programme aller tantôt sur un classeur, tantôt sur l'autre. Inutile de dire que ça donne un écran qui clignote, ce qui n'est pas très agréable. Comment est-ce que je pourrais modifier le code pour ne pas avoir ce clignotement ?

En vous remerciant grandement pour votre aide, je vous souhaite une bonne journée.

Rod'

Sub ACCUEIL_Bouton5_Cliquer()

Dim c As Integer, p As Integer, d As Integer, q As Integer

c = 8
s = 8
e = 9
p = 2
d = 7
r = 5
q = 1

Workbooks.Open ("...")
Sheets("Topographie").Select
Windows("Français.V2").Activate
Sheets("Infrastructure").Activate

Do While Not (IsEmpty(ActiveCell))

'Copie courbes'

Windows("Français.V2").Activate
Sheets("Infrastructure").Select
Range("F" & c).Copy
Windows("Topographie").Activate
Sheets("Topographie").Select
Range("C" & d).PasteSpecial
Range("C" & d).Copy
Range("G" & d).PasteSpecial

Windows("Français.V2").Activate
Sheets("Infrastructure").Select
Range("F" & e).Copy
Windows("Topographie").Activate
Sheets("Topographie").Select
Range("D" & d).PasteSpecial
Range("D" & d).Copy
Range("H" & d).PasteSpecial

Windows("Français.V2").Activate
Sheets("Infrastructure").Select
Range("G" & c).Copy
Windows("Topographie").Activate
Sheets("Topographie").Select
Range("E" & d).PasteSpecial
Range("E" & d).Copy
Range("I" & d).PasteSpecial

'Copie pentes'

Windows("Français.V2").Activate
Sheets("Infrastructure").Select
Range("H" & d).Copy
Windows("Topographie").Activate
Sheets("Topographie").Select
Range("K" & d).PasteSpecial
Range("M" & d).PasteSpecial

Windows("Français.V2").Activate
Sheets("Infrastructure").Select
Range("I" & d).Copy
Windows("Topographie").Activate
Sheets("Topographie").Select
Range("L" & d).PasteSpecial
Range("N" & d).PasteSpecial

'Copie Vmax'

Windows("Français.V2").Activate
Sheets("Infrastructure").Select
Range("J" & d).Copy
Windows("Topographie").Activate
Sheets("Topographie").Select
Range("P" & d).PasteSpecial
Range("T" & d).PasteSpecial

Windows("Français.V2").Activate
Sheets("Infrastructure").Select
Range("K" & d).Copy
Windows("Topographie").Activate
Sheets("Topographie").Select
Range("Q" & d).PasteSpecial
Range("U" & d).PasteSpecial

'Copie carrefours'

Windows("Français.V2").Activate
Sheets("Infrastructure").Select
Range("E" & d).Copy
Windows("Topographie").Activate
Sheets("Topographie").Select
Range("W" & d).PasteSpecial

Windows("Français.V2").Activate
Sheets("Infrastructure").Select
Range("D" & d).Copy
Windows("Topographie").Activate
Sheets("Topographie").Select
Range("X" & d).PasteSpecial
Range("Y" & d).PasteSpecial

'Copie stations'

Windows("Français.V2").Activate
Sheets("Stations").Select
Range("D" & s).Copy
Windows("Topographie").Activate
Sheets("Stations").Select
Range("C" & r).PasteSpecial

Windows("Français.V2").Activate
Sheets("Stations").Select
Range("C" & s).Copy
Windows("Topographie").Activate
Sheets("Stations").Select
Range("D" & r).PasteSpecial
Range("H" & r).PasteSpecial

Windows("Français.V2").Activate
Sheets("Stations").Select
Range("E" & s).Copy
Windows("Topographie").Activate
Sheets("Stations").Select
Range("E" & r).PasteSpecial
Range("I" & r).PasteSpecial

s = s + q
c = c + p
d = d + q
e = e + p
r = r + q

Loop

Windows("Topographie").Activate
ActiveSheet.Calculate
Sheets("Versions").Activate

End Sub

Bonjour Rododom, bonjour le forum,

il faut impérativement éviter les Select inutiles pour éviter les fameux clignotement d'écran et pour accélérer l'exécution du code on utilise au début :

Application.ScreenUpdating = False

sans oublier de mettre à la fin :

Application.ScreenUpdating = True

Ton code respectant ces deux conseils (à vérifier quand même parce que j'ai fait vite...) :

Sub ACCUEIL_Bouton5_Cliquer()
Dim CS As Workbook 'Classeur Source
Dim OS As Worksheet 'Onglet Source
Dim CD As Workbook 'Classeur Destination
Dim OD As Worksheet 'Onglet Destination
Dim c As Integer, p As Integer, d As Integer, q As Integer
Dim s As Integer, e As Integer, r As Integer 'pourquoi pas elles, elles sentent le pâté ?

Application.ScreenUpdating = False
c = 8
s = 8
e = 9
p = 2
d = 7
r = 5
q = 1

Set CS = ThisWorkbook
Set OS = CS.Worksheets("Infrastructure")
Workbooks.Open ("...")
Set CD = ActiveWorkbook
Set OD = CD.Worksheets("Topographie")

Do Until OS.Cells(c, "F") = ""

    'Copie courbes'
    OS.Cells(c, "F").Copy OD.Cells(d, "C")
    OS.Cells(c, "F").Copy OD.Cells(d, "G")
    OS.Cells(e, "F").Copy OD.Cells(d, "D")
    OS.Cells(e, "F").Copy OD.Cells(d, "H")
    OS.Cells(c, "G").Copy OD.Cells(d, "E")
    OS.Cells(c, "G").Copy OD.Cells(d, "I")

    'Copie pentes'
    OS.Cells(d, "H").Copy OD.Cells(d, "K")
    OS.Cells(d, "H").Copy OD.Cells(d, "M")
    OS.Cells(d, "I").Copy OD.Cells(d, "L")
    OS.Cells(d, "I").Copy OD.Cells(d, "N")

    'Copie Vmax'
    OS.Cells(d, "J").Copy OD.Cells(d, "P")
    OS.Cells(d, "J").Copy OD.Cells(d, "T")
    OS.Cells(d, "K").Copy OD.Cells(d, "Q")
    OS.Cells(d, "K").Copy OD.Cells(d, "U")

    'Copie carrefours'
    OS.Cells(d, "E").Copy OD.Cells(d, "W")
    OS.Cells(d, "D").Copy OD.Cells(d, "X")
    OS.Cells(d, "D").Copy OD.Cells(d, "Y")

    'Copie stations'
    OS.Cells(s, "D").Copy OD.Cells(r, "C")
    OS.Cells(s, "C").Copy OD.Cells(r, "D")
    OS.Cells(s, "C").Copy OD.Cells(r, "H")
    OS.Cells(s, "E").Copy OD.Cells(r, "E")
    OS.Cells(s, "E").Copy OD.Cells(r, "I")

    s = s + q
    c = c + p
    d = d + q
    e = e + p
    r = r + q

Loop

OD.Calculate
OD.Shapes("Versions").Activate
Application.ScreenUpdating = False
End Sub

Bonjour ThauThème !

Franchement...ce code est magnifique, ça fait exactement ce que je veux.

J'ai juste eu à rajouté un onglet source et un onglet destination (pour les dernières valeurs ça change), mais c'était facile à faire.

J'ai juste un petit message d'erreur qui apparaît, disant "Erreur d'exécution '-2147024809 (80070057) : L'élément portant ce nom est introuvable"...a priori ça ne gâche pas l'effet, mais j'aimerais que ce message cesse d'apparaître pour avoir quelque chose de tout beau tout chaud.

Est-ce que tu aurais une idée de comment contrecarrer cette erreur par hasard ?

Re,

Étrange ce numéro d'erreur... Mais sans le fichier qui va bien difficile de t'aider davantage...

Re,

L'ennui c'est que mon fichier faire bien 20Mo, et qu'il m'est impossible a priori de le découper pour en sortir l'extrait dont j'ai besoin.

Mais merci beaucoup pour ton aide, je vais me contenter de ça pour le moment et cocher ce sujet comme résolu. Si un jour j'ai vraiment besoin de virer cette erreur, je reviendrai peut-être. Mais comme j'ai dit, ça n'a pas l'air d'affecter le fonctionnement du code. Donc ce n'est pas très important.

Merci beaucoup, bonne fin de journée !

Rechercher des sujets similaires à "arret boucle clignotement vba"